Add more primitives to the [Monad.Make] arguments.

For optimisation purposes.

2 files changed, 25 insertions, 15 deletions

diff --git a/lib/monad.ml b/lib/monad.ml
index dc5809407b..2d305a3c97 100644
--- a/lib/monad.ml
+++ b/lib/monad.ml
@@ -10,17 +10,24 @@
 (** Combinators on monadic computations. *)
 
 
-(** A minimal definition necessary for the definition to go through. *)
+(** A definition of monads, each of the combinators is used in the
+    [Make] functor. *)
 module type Def = sig
 
   type +'a t
   val return : 'a -> 'a t
   val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+  val (>>) : unit t -> 'a t -> 'a t
+  val map : ('a -> 'b) -> 'a t -> 'b t
 
   (** The monadic laws must hold:
       - [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)]
       - [return a >>= f] = [f a]
-      - [x>>=return] = [x]  *)
+      - [x>>=return] = [x]
+
+      As well as the following identities:
+      - [x >> y] = [x >>= fun () -> y]
+      - [map f x] = [x >>= fun x' -> f x'] *)
 
 end
 
@@ -93,24 +100,20 @@ module Make (M:Def) : S with type +'a t = 'a M.t = struct
     let rec map f = function
       | [] -> return []
       | [a] ->
-          f a >>= fun a' ->
-          return [a']
+          M.map (fun a' -> [a']) (f a)
       | a::b::l ->
           f a >>= fun a' ->
           f b >>= fun b' ->
-          map f l >>= fun l' ->
-          return (a'::b'::l')
+          M.map (fun l' -> a'::b'::l') (map f l)
 
     let rec map_right f = function
       | [] -> return []
       | [a] ->
-          f a >>= fun a' ->
-          return [a']
+          M.map (fun a' -> [a']) (f a)
       | a::b::l ->
           map f l >>= fun l' ->
           f b >>= fun b' ->
-          f a >>= fun a' ->
-          return (a'::b'::l')
+          M.map (fun a' -> a'::b'::l') (f a)
 
     let rec fold_right f l x =
       match l with
diff --git a/lib/monad.mli b/lib/monad.mli
index c72e584db1..d5c5cbc692 100644
--- a/lib/monad.mli
+++ b/lib/monad.mli
@@ -10,17 +10,24 @@
 (** Combinators on monadic computations. *)
 
 
-(** A minimal definition necessary for the definition to go through. *)
+(** A definition of monads, each of the combinators is used in the
+    [Make] functor. *)
 module type Def = sig
 
   type +'a t
   val return : 'a -> 'a t
   val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+  val (>>) : unit t -> 'a t -> 'a t
+  val map : ('a -> 'b) -> 'a t -> 'b t
 
-  (** The monadic laws must hold:
-      - [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)]
-      - [return a >>= f] = [f a]
-      - [x>>=return] = [x]  *)
+(** The monadic laws must hold:
+    - [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)]
+    - [return a >>= f] = [f a]
+    - [x>>=return] = [x]
+
+    As well as the following identities:
+    - [x >> y] = [x >>= fun () -> y]
+    - [map f x] = [x >>= fun x' -> f x'] *)
 
 end