Source

ocaml_monad_io / iO_Lwt.ml

Diff from to

iO_Lwt.ml

 
 value run_and_ignore_result = Lwt.ignore_result
 ;
+
+
+(********************************************************)
+
+module Sequence_Sequential
+ =
+  struct
+    type io_m +'a = m 'a;
+    type m +'a = io_m 'a;
+
+    value ( >>= ) = Lwt.bind;
+    value bind = bind;
+    value return = return;
+    value bind_rev = bind_rev;
+
+    value (sequence_array : array (m 'a) -> m (array 'a)) arr_m_a =
+      let len = Array.length arr_m_a in
+      if len = 0
+      then return [| |]
+      else
+        arr_m_a.(0) >>= fun a0 ->
+        let res = Array.make len a0 in
+        inner 1
+        where rec inner i =
+          if i = len
+          then return res
+          else
+            arr_m_a.(i) >>= fun a ->
+            ( res.(i) := a
+            ; inner (i + 1)
+            )
+    ;
+
+  end
+;
+
+
+module Sequence_Parallel
+ =
+  struct
+    type io_m +'a = m 'a;
+    type m +'a = io_m 'a;
+
+    value ( >>= ) = Lwt.bind;
+    value bind = bind;
+    value return = return;
+    value bind_rev = bind_rev;
+
+    value (sequence_array : array (m 'a) -> m (array 'a)) arr_m_a =
+      let len = Array.length arr_m_a in
+      if len = 0
+      then return [| |]
+      else
+        let res_opt = Array.make len None in
+        let writer i m_a =
+          m_a >>= fun a ->
+          (res_opt.(i) := Some a; return ())
+        in
+        let writers = inner [] 0
+          where rec inner acc i =
+            if i = len
+            then acc
+            else inner [writer i arr_m_a.(i) :: acc] (i + 1)
+        in
+        Lwt.join writers >>= fun () ->
+        let res = Array.map
+          (fun [None -> assert False | Some x -> x])
+          res_opt
+        in
+          return res
+    ;
+
+  end
+;
+
+value sequence_array = Sequence_Parallel.sequence_array;
+