1. camlspotter
  2. spotlib

Commits

camlspotter  committed a626d15

update

  • Participants
  • Parent commits ea8524f
  • Branches default

Comments (0)

Files changed (3)

File lib/monad.ml

View file
 open Monad_intf
 
 module Generic = struct
+
   module type MONAD = sig
-    type a
-    module Repr (M : S) : sig
-      val extract : a M.t
-    end
+    type a (** the parameter *)
+
+    (** The generic monad is a function, 
+        waiting an actual implementation of a monad *)
+    module F(M : S) : sig val it : a M.t end
   end
     
   type 'a t = (module MONAD with type a = 'a)
   
-  let return (type a_) (a_ : a_) = (module struct
-    type a = a_
-    module Repr (M : S) = struct
-      let extract = M.return a_
-    end
-  end : MONAD with type a = a_)
-      
-  let bind (type a_) (type b_) (a_t : a_ t) (f : a_ -> b_ t) = (module struct
-    type a = b_
-    module AT = (val a_t)
-    module Repr (M : S) = struct
-      let at : a_ M.t = 
-        let module AT' = AT.Repr(M) in
-        AT'.extract
-      let extract : b_ M.t = M.bind at (fun a -> 
-        let b_t : b_ t = f a in
-        let module BT = (val b_t) in
-        let module BT' = BT.Repr(M) in
-        BT'.extract)
-    end
-  end : MONAD with type a = b_)
+  let return (type alpha) (alpha : alpha) : alpha t = (module struct
+      type a = alpha
+      module F (M : S) = struct let it = M.return alpha end
+    end)
+
+  let bind (type alpha) (type beta) 
+      (module AT : MONAD with type a = alpha)  (* = module AT : alpha t *)
+      (f : alpha -> beta t) : beta t = 
+    (module struct
+      type a = beta
+          
+      module F (M : S) = struct
+        let it = 
+          let aMt = let module ATFM = AT.F(M) in ATFM.it in
+          M.bind aMt (fun a -> 
+            let (module BT) = f a in
+            let module BTFM = BT.F(M) in BTFM.it)
+      end
+    end)
   
   module MakeRun( M : S ) = struct
-    let run (type a_) (a_t : a_ t) =
-      let module AT = (val a_t) in
-      let module AT' = AT.Repr(M) in
-      AT'.extract
+    let run (type alpha) (module AT : MONAD with type a = alpha) =
+      let module ATFM = AT.F(M) in ATFM.it
   end
   
   let (>>=) = bind
   let join tt = tt >>= fun at -> at
 end
 
-include Generic
-
 module Make(M:S) : sig 
   include T with type 'a t := 'a M.t 
   val run : 'a Generic.t -> 'a M.t

File lib/monad.mli

View file
   val join : 'a t t -> 'a t
 end
 
-include module type of Generic
-
 module Make(M : S) : sig
   include T with type 'a t := 'a M.t
   val run : 'a Generic.t -> 'a M.t

File lib/xlist.mli

View file
 
 val filter_map : ('a -> 'b option) -> 'a list -> 'b list
 val concat_map : ('a -> 'b list) -> 'a list -> 'b list
+(** concatMap of Haskell. bind for the list monad. Non tail rec *)
 
 val take : int -> 'a list -> 'a list
 val drop : int -> 'a list -> 'a list