Join and First

Author: clarus

ioSystem.ml

@@ -1,6 +1,17 @@
 (** Some OCaml primitives for the extraction. *)
 open Big_int
 
+module Sum = struct
+  type ('a, 'b) t =
+    | Left of 'a
+    | Right of 'b
+
+  let destruct (s : ('a, 'b) t) (c_x : 'a -> 'c) (c_y : 'b -> 'c) : 'c =
+    match s with
+    | Left x -> c_x x
+    | Right y -> c_y y
+end
+
 (** Interface to the OCaml strings. *)
 module String = struct
   (** Export an OCaml string. *)
@@ -24,6 +35,24 @@ end
 let argv : string list =
   Array.to_list Sys.argv
 
+(** Join. *)
+let join (x : 'a Lwt.t) (y : 'b Lwt.t) : ('a * 'b) Lwt.t =
+  let r_x = ref None in
+  let r_y = ref None in
+  Lwt.bind (Lwt.join [
+    Lwt.bind x (fun x -> r_x := Some x; Lwt.return ());
+    Lwt.bind y (fun y -> r_y := Some y; Lwt.return ())])
+    (fun (_ : unit) ->
+      match (!r_x, !r_y) with
+      | (Some x, Some y) -> Lwt.return (x, y)
+      | _ -> Lwt.fail_with "The join expected two answers.")
+
+(** First. *)
+let first (x : 'a Lwt.t) (y : 'b Lwt.t) : ('a, 'b) Sum.t Lwt.t =
+  Lwt.choose [
+    Lwt.bind x (fun x -> Lwt.return @@ Sum.Left x);
+    Lwt.bind y (fun y -> Lwt.return @@ Sum.Right y)]
+
 (** List the files of a directory. *)
 let list_files (directory : string) : string list option Lwt.t =
   Lwt.catch (fun _ ->