ADD Scheduler and tests
M .builds/alpine.yml +1 -0
@@ 1,5 1,6 @@ 
 image: alpine/edge
 packages:
+  - m4
   - make
   - mercurial
   - opam

          
M code/pds.conf +8 -1
@@ 22,5 22,12 @@ extra_compiler_opts = "-safe-string"
 [src.byocm_fut]
 install = false
 
+[src.byocm_sched]
+install = false
+deps = [ "byocm_fut" ]
+
 [tests.byocm_fut]
-deps = [ "byocm_fut" ]
  No newline at end of file
+deps = [ "byocm_fut" ]
+
+[tests.byocm_sched]
+deps = [ "byocm_fut", "byocm_sched" ]

          
M code/src/byocm_fut/byocm_fut.ml +28 -7
@@ 10,6 10,10 @@ and 'a undet = { mutable watchers : ('a 
 external t_of_u : 'a u -> 'a t = "%identity"
 external u_of_t : 'a t -> 'a u = "%identity"
 
+let rec collapse_alias = function
+  | { state = `Alias u } -> collapse_alias u
+  | u -> u
+
 module Promise = struct
   type 'a fut = 'a t
   type 'a t = 'a fut

          
@@ 26,18 30,35 @@ module Promise = struct
         assert false
 end
 
-let rec collapse_alias = function
-  | { state = `Alias u } -> collapse_alias u
-  | u -> u
-
 let return v = t_of_u { state = `Det v }
-let bind t f =
+let bind : 'a t -> ('a -> 'b t) -> 'b t = fun t f ->
   let u = collapse_alias (u_of_t t) in
   match u with
     | { state = `Det v } ->
       f v
-    | { state = `Undet { watchers = watchers } } ->
-      failwith "nyi"
+    | { state = `Undet undet } ->
+      let p = Promise.create () in
+      let fut = Promise.future p in
+      let w =
+        fun v ->
+          let u = collapse_alias (u_of_t (f v)) in
+          match u with
+            | { state = `Det v' } ->
+              Promise.set p v'
+            | { state = `Undet undet' } ->
+              begin match collapse_alias (u_of_t fut) with
+                | { state = `Undet undet'' } as fut' ->
+                  undet'.watchers <- undet'.watchers @ undet''.watchers;
+                  fut'.state <- `Alias u
+                | { state = `Det _ }
+                | { state =  `Alias _ } ->
+                  assert false
+              end
+            | _ ->
+              assert false
+      in
+      undet.watchers <- w::undet.watchers;
+      fut
     | { state = `Alias _ } ->
       assert false
 

          
A => code/src/byocm_sched/byocm_sched.ml +44 -0
@@ 0,0 1,44 @@ 
+module Float_map = Map.Make(struct type t = float let compare = compare end)
+
+let timers = ref Float_map.empty
+
+let rec exec_timers now =
+  match Float_map.min_binding_opt !timers with
+    | Some (n, p) when n <= now ->
+      timers := Float_map.remove n !timers;
+      Byocm_fut.Promise.set p ();
+      exec_timers now
+    | _ ->
+      ()
+
+let rec loop finished =
+  match Byocm_fut.state finished with
+    | `Det v ->
+      v
+    | `Undet ->
+      next_iter ();
+      loop finished
+and next_iter () =
+  let now = Unix.time () in
+  match Float_map.min_binding_opt !timers with
+    | Some (n, _) when n > now ->
+      ignore (Unix.select [] [] [] (n -. now))
+    | _ ->
+      exec_timers now
+
+let sleep time =
+  let trigger_time = Unix.time () +. time in
+  let p =
+    try
+      Float_map.find trigger_time !timers
+    with
+      | Not_found ->
+        let p = Byocm_fut.Promise.create () in
+        timers := Float_map.add trigger_time p !timers;
+        p
+  in
+  Byocm_fut.Promise.future p
+
+let run f =
+  loop (f ())
+

          
A => code/src/byocm_sched/byocm_sched.mli +3 -0
@@ 0,0 1,3 @@ 
+val sleep : float -> unit Byocm_fut.t
+
+val run : (unit -> 'a Byocm_fut.t) -> 'a

          
M code/tests/byocm_fut/test.ml +20 -1
@@ 25,7 25,26 @@ let test3 () =
   Byocm_fut.Promise.set p "hello";
   assert (Byocm_fut.state res = `Det "hello world")
 
+let test4 () =
+  let open Byocm_fut.Infix_monad in
+  let p1 = Byocm_fut.Promise.create () in
+  let p2 = Byocm_fut.Promise.create () in
+  let fut = Byocm_fut.Promise.future p1 in
+  let res =
+    fut
+    >>= fun () ->
+    Byocm_fut.Promise.future p2
+    >>= fun s ->
+    Byocm_fut.return (s ^ " world")
+  in
+  assert (Byocm_fut.state res = `Undet);
+  Byocm_fut.Promise.set p1 ();
+  assert (Byocm_fut.state res = `Undet);
+  Byocm_fut.Promise.set p2 "hello";
+  assert (Byocm_fut.state res = `Det "hello world")
+
 let () =
   test1 ();
   test2 ();
-  test3 ()
+  test3 ();
+  test4 ()

          
A => code/tests/byocm_sched/test.ml +37 -0
@@ 0,0 1,37 @@ 
+let test1 () =
+  let f () = Byocm_sched.sleep 1.0 in
+  let v = Byocm_sched.run f in
+  assert (v = ())
+
+let test2 () =
+  let f () =
+    let open Byocm_fut.Infix_monad in
+    let t1 = Unix.time () in
+    Byocm_sched.sleep 1.0
+    >>= fun () ->
+    let t2 = Unix.time () in
+    Byocm_fut.return (t2 -. t1)
+  in
+  let v = Byocm_sched.run f in
+  assert (v >= 1.0 && v <= 1.5)
+
+let test3 () =
+  let f () =
+    let open Byocm_fut.Infix_monad in
+    let t1 = Unix.time () in
+    let fut1 = Byocm_sched.sleep 1.0 in
+    let fut2 = Byocm_sched.sleep 1.5 in
+    fut1
+    >>= fun () ->
+    fut2
+    >>= fun () ->
+    let t2 = Unix.time () in
+    Byocm_fut.return (t2 -. t1)
+  in
+  let v = Byocm_sched.run f in
+  assert (v >= 1.5 && v <= 2.0)
+
+let () =
+  test1 ();
+  test2 ();
+  test3 ()