Commits

Anonymous committed 3ee622d

+ IO_Sequence

Comments (0)

Files changed (3)

 open IO_Types;
 module Test_Lwt_Pure = (IO_Lwt : IO_Pure);
 module Test_Lwt_PureError = (IO_Lwt : IO_PureError);
+module Test_Lwt_Sequence = (IO_Lwt : IO_Sequence);
+module Test_Lwt_Sequence_s = (IO_Lwt.Sequence_Sequential : IO_Sequence);
+module Test_Lwt_Sequence_p = (IO_Lwt.Sequence_Parallel : IO_Sequence);
 
 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;
+
 
   end
 ;
+
+
+module type IO_Sequence
+ =
+  sig
+
+    type m +'a;
+
+    value return : 'a -> m 'a;
+    value bind : ('a -> m 'b) -> m 'a -> m 'b;
+    value bind_rev : m 'a -> ('a -> m 'b) -> m 'b;
+
+    value sequence_array : array (m 'a) -> m (array 'a);
+
+  end
+;