started refactoring Future

future.mli

@@ -25,9 +25,6 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Futures for concurrency} *)
 
-type 'a t
-  (** A future value of type 'a *)
-
 exception SendTwice
   (** Exception raised when a future is evaluated several time *)
 
@@ -59,113 +56,103 @@ module MVar : sig
     (** Look at the value, without removing it *)
 end
 
-(** {2 Thread pool} *)
+(** {2 Signature} *)
-module Pool : sig
-  type t
-    (** A pool of threads *)
 
-  val create : ?timeout:float -> size:int -> t
+module type S = sig
-    (** Create a pool with at most the given number of threads. [timeout]
+  type 'a t
-        is the time after which idle threads are killed. *)
+    (** A future value of type 'a *)
 
-  val size : t -> int
+  val run : (unit -> unit) -> unit
-    (** Current size of the pool *)
-
-  val run : t -> (unit -> unit) -> unit
     (** Run the function in the pool *)
 
-  val finish : t -> unit
+  val finish : unit -> unit
-    (** Kill threads in the pool *)
+    (** Kill threads in the pool. The pool won't be usable any more. *)
-end
 
-val default_pool : Pool.t
+  (** {2 Basic low-level Future functions} *)
-  (** Pool of threads that is used by default. Growable if needed. *)
 
-(** {2 Basic low-level Future functions} *)
+  type 'a state =
+    | NotKnown
+    | Success of 'a
+    | Failure of exn
 
-val make : Pool.t -> 'a t
+  val state : 'a t -> 'a state
-  (** Create a future, representing a value that is not known yet. *)
+    (** Current state of the future *)
 
-val get : 'a t -> 'a
+  val is_done : 'a t -> bool
-  (** Blocking get: wait for the future to be evaluated, and get the value,
+    (** Is the future evaluated (success/failure)? *)
-      or the exception that failed the future is returned *)
 
-val send : 'a t -> 'a -> unit
+  (** {2 Combinators} *)
-  (** Send a result to the future. Will raise SendTwice if [send] has
-      already been called on this future before *)
 
-val fail : 'a t -> exn -> unit
+  val on_success : 'a t -> ('a -> unit) -> unit
-  (** Fail the future by raising an exception inside it *)
+    (** Attach a handler to be called upon success *)
 
-val is_done : 'a t -> bool
+  val on_failure : _ t -> (exn -> unit) -> unit
-  (** Is the future evaluated (success/failure)? *)
+    (** Attach a handler to be called upon failure *)
 
-(** {2 Combinators} *)
+  val on_finish : _ t -> (unit -> unit) -> unit
+    (** Attach a handler to be called when the future is evaluated *)
 
-val on_success : 'a t -> ('a -> unit) -> unit
+  val flatMap : ('a -> 'b t) -> 'a t -> 'b t
-  (** Attach a handler to be called upon success *)
+    (** Monadic combination of futures *)
 
-val on_failure : _ t -> (exn -> unit) -> unit
+  val andThen : 'a t -> (unit -> 'b t) -> 'b t
-  (** Attach a handler to be called upon failure *)
+    (** Wait for the first future to succeed, then launch the second *)
 
-val on_finish : _ t -> (unit -> unit) -> unit
+  val sequence : 'a t list -> 'a list t
-  (** Attach a handler to be called when the future is evaluated *)
+    (** Future that waits for all previous sequences to terminate *)
 
-val flatMap : ?pool:Pool.t -> ('a -> 'b t) -> 'a t -> 'b t
+  val choose : 'a t list -> 'a t
-  (** Monadic combination of futures *)
+    (** Choose among those futures (the first to terminate) *)
 
-val andThen : ?pool:Pool.t -> 'a t -> (unit -> 'b t) -> 'b t
+  val map : ('a -> 'b) -> 'a t -> 'b t
-  (** Wait for the first future to succeed, then launch the second *)
+    (** Maps the value inside the future *)
 
-val sequence : ?pool:Pool.t -> 'a t list -> 'a list t
+  (** {2 Future constructors} *)
-  (** Future that waits for all previous sequences to terminate *)
 
-val choose : ?pool:Pool.t -> 'a t list -> 'a t
+  val return : 'a -> 'a t
-  (** Choose among those futures (the first to terminate) *)
+    (** Future that is already computed *)
 
-val map : ?pool:Pool.t -> ('a -> 'b) -> 'a t -> 'b t
+  val spawn : (unit -> 'a) -> 'a t
-  (** Maps the value inside the future *)
+    (** Spawn a thread that wraps the given computation *)
 
-(** {2 Future constructors} *)
+  val spawn_process : ?stdin:string -> cmd:string ->
+                      (int * string * string) t
+    (** Spawn a sub-process with the given command [cmd] (and possibly input);
+        returns a future containing (returncode, stdout, stderr) *)
 
-val return : 'a -> 'a t
+  val sleep : float -> unit t
-  (** Future that is already computed *)
+    (** Future that returns with success in the given amount of seconds *)
 
-val spawn : ?pool:Pool.t -> (unit -> 'a) -> 'a t
+  (** {2 Event timer} *)
-  (** Spawn a thread that wraps the given computation *)
 
-val spawn_process : ?pool:Pool.t -> ?stdin:string -> cmd:string ->
+  module Timer : sig
-                    (int * string * string) t
+    val schedule_at : at:float -> (unit -> unit) -> unit
-  (** Spawn a sub-process with the given command [cmd] (and possibly input);
+      (** [schedule_at ~at act] will run [act] at the Unix echo [at] *)
-      returns a future containing (returncode, stdout, stderr) *)
 
-val sleep : ?pool:Pool.t -> float -> unit t
+    val schedule_after : after:float -> (unit -> unit) -> unit
-  (** Future that returns with success in the given amount of seconds *)
+      (** [schedule_after ~after act] will run [act] in [after] seconds *)
+  end
 
-(** {2 Event timer} *)
+  module Infix : sig
+    val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+    val (>>) : 'a t -> (unit -> 'b t) -> 'b t
+  end
 
-module Timer : sig
-  type t
-    (** A scheduler for events *)
-
-  val create : ?pool:Pool.t -> unit -> t
-    (** A timer that runs tasks in the given thread pool *)
-
-  val schedule_at : t -> float -> (unit -> unit) -> unit
-    (** [schedule_at s t act] will run [act] at the Unix echo [t] *)
-
-  val schedule_in : t -> float -> (unit -> unit) -> unit
-    (** [schedule_in s d act] will run [act] in [d] seconds *)
-
-  val stop : t -> unit
-    (** Stop the given timer, cancelling pending tasks *)
-end
-
-
-module Infix : sig
   val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
   val (>>) : 'a t -> (unit -> 'b t) -> 'b t
 end
 
-val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+(** {2 Functor} *)
-val (>>) : 'a t -> (unit -> 'b t) -> 'b t
+
+module type CONFIG = sig
+  val timeout : float
+
+  val max_size : int
+end
+
+module DefaultConfig : CONFIG
+
+module Make(C : CONFIG) : S
+
+(** Standard (default) pool *)
+module Std : S

tests/test_future.ml

@@ -1,45 +1,50 @@
 
-(** Test Future *)
+(** Test F *)
 
 open OUnit
 
+module F = Future.Std
+module MVar = Future.MVar
+
 let test_mvar () =
-  let box = Future.MVar.empty () in
+  let box = MVar.empty () in
-  let f = Future.spawn (fun () -> Future.MVar.take box + 1) in
+  let f = F.spawn (fun () -> MVar.take box + 1) in
   Thread.delay 0.1;
-  OUnit.assert_bool "still waiting" (not (Future.is_done f));
+  OUnit.assert_bool "still waiting" (not (F.is_done f));
-  Future.MVar.put box 1;
+  MVar.put box 1;
-  OUnit.assert_equal 2 (Future.get f);
+  Thread.delay 1.;
+  OUnit.assert_equal (F.Success 2) (F.state f);
   ()
 
 let test_parallel () =
   let open Gen.Infix in
   let l = 1 -- 300
-    |> Gen.map (fun _ -> Future.spawn (fun () -> Thread.delay 0.1; 1))
+    |> Gen.map (fun _ -> F.spawn (fun () -> Thread.delay 0.1; 1))
     |> Gen.to_list in
-  let l' = List.map Future.get l in
+  let l' = F.map (List.fold_left (+) 0) (F.sequence l) in
-  OUnit.assert_equal 300 (List.fold_left (+) 0 l');
+  Thread.delay 0.5;
+  OUnit.assert_equal (F.Success 300) (F.state l');
   ()
 
 let test_time () =
   let start = Unix.gettimeofday () in
-  let f1 = Future.spawn (fun () -> Thread.delay 0.5) in
+  let f1 = F.spawn (fun () -> Thread.delay 0.5) in
-  let f2 = Future.spawn (fun () -> Thread.delay 0.5) in
+  let f2 = F.spawn (fun () -> Thread.delay 0.5) in
-  Future.get f1;
+  F.get f1;
-  Future.get f2;
+  F.get f2;
   let stop = Unix.gettimeofday () in
   OUnit.assert_bool "parallelism" (stop -. start < 0.75);
   ()
 
 let test_timer () =
-  let timer = Future.Timer.create () in
+  let timer = F.Timer.create () in
-  let mvar = Future.MVar.full 1 in
+  let mvar = MVar.full 1 in
-  Future.Timer.schedule_in timer 0.5
+  F.Timer.schedule_in timer 0.5
-    (fun () -> ignore (Future.MVar.update mvar (fun x -> x + 2)));
+    (fun () -> ignore (MVar.update mvar (fun x -> x + 2)));
-  Future.Timer.schedule_in timer 0.2
+  F.Timer.schedule_in timer 0.2
-    (fun () -> ignore (Future.MVar.update mvar (fun x -> x * 4)));
+    (fun () -> ignore (MVar.update mvar (fun x -> x * 4)));
   Thread.delay 0.7;
-  OUnit.assert_equal 6 (Future.MVar.peek mvar);
+  OUnit.assert_equal 6 (MVar.peek mvar);
   ()
 
 let suite =