add appliative instance in CCPool, factor code

src/threads/CCPool.ml

@@ -309,18 +309,29 @@ module Make(P : PARAM) = struct
           | Failed e -> k e
           | _ -> ())
 
-    let map f fut = match fut with
+    let map_cell_ ~async f cell ~into:cell' =
-      | Return x -> Return (f x)
-      | FailNow e -> FailNow e
-      | Run cell ->
-          let cell' = create_cell() in
       add_handler_ cell
         (function
-              | Done x -> run_and_set1 cell' f x
+          | Done x ->
+              if async
+              then run3 run_and_set1 cell' f x
+              else run_and_set1 cell' f x
           | Failed e -> set_fail_ cell' e
           | Waiting -> assert false);
       Run cell'
 
+    let map_ ~async f fut = match fut with
+      | Return x ->
+          if async
+          then make1 f x
+          else Return (f x)
+      | FailNow e -> FailNow e
+      | Run cell -> map_cell_ ~async f cell ~into:(create_cell())
+
+    let map f fut = map_ ~async:false f fut
+
+    let map_async f fut = map_ ~async:true f fut
+
     (*$R
       let a = Fut.make (fun () -> 1) in
       let b = Fut.map (fun x -> x+1) a in
@@ -328,19 +339,30 @@ module Make(P : PARAM) = struct
       OUnit.assert_equal 1 (Fut.get c)
     *)
 
-    (* same as {!map}, but schedules the computation of [f] in the pool *)
+    let app_ ~async f x = match f, x with
-    let map_async f fut = match fut with
+      | Return f, Return x ->
-      | Return x -> make1 f x
+          if async
-      | FailNow e -> FailNow e
+          then make1 f x
-      | Run cell ->
+          else Return (f x)
+      | FailNow e, _
+      | _, FailNow e -> FailNow e
+      | Return f, Run x ->
+          map_cell_ ~async (fun x -> f x) x ~into:(create_cell())
+      | Run f, Return x ->
+          map_cell_ ~async (fun f -> f x) f ~into:(create_cell())
+      | Run f, Run x ->
           let cell' = create_cell () in
-          add_handler_ cell
+          add_handler_ f
             (function
-              | Done x -> run3 run_and_set1 cell' f x
+              | Done f -> ignore (map_cell_ ~async f x ~into:cell')
               | Failed e -> set_fail_ cell' e
               | Waiting -> assert false);
           Run cell'
 
+    let app f x = app_ ~async:false f x
+
+    let app_async f x = app_ ~async:true f x
+
     let flat_map f fut = match fut with
       | Return x -> f x
       | FailNow e -> FailNow e
@@ -489,6 +511,7 @@ module Make(P : PARAM) = struct
       let (>>=) x f = flat_map f x
       let (>>) a f = and_then a f
       let (>|=) a f = map f a
+      let (<*>) = app
     end
 
     include Infix

src/threads/CCPool.mli

@@ -132,6 +132,13 @@ module Make(P : PARAM) : sig
     val map_async : ('a -> 'b) -> 'a t -> 'b t
     (** Maps the value inside the future, to be computed in a separated job. *)
 
+    val app : ('a -> 'b) t -> 'a t -> 'b t
+    (** [app f x] applies the result of [f] to the result of [x] *)
+
+    val app_async : ('a -> 'b) t -> 'a t -> 'b t
+    (** [app f x] applies the result of [f] to the result of [x], in
+        a separated job scheduled in the pool *)
+
     val sleep : float -> unit t
     (** Future that returns with success in the given amount of seconds. Blocks
         the thread! If you need to wait on many events, consider
@@ -141,10 +148,17 @@ module Make(P : PARAM) : sig
       val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
       val (>>) : 'a t -> (unit -> 'b t) -> 'b t
       val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+      val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
     end
 
     val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+
     val (>>) : 'a t -> (unit -> 'b t) -> 'b t
+
     val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+    (** Alias to {!map} *)
+
+    val (<*>): ('a -> 'b) t -> 'a t -> 'b t
+    (** Alias to {!app} *)
   end
 end