diff --git a/core/CCCat.ml b/core/CCCat.ml index fe9d6f6f..cb9ab343 100644 --- a/core/CCCat.ml +++ b/core/CCCat.ml @@ -46,13 +46,17 @@ module type APPLICATIVE = sig val (<*>) : ('a -> 'b) t -> 'a t -> 'b t end -module type MONAD = sig +module type MONAD_BARE = sig type +'a t - include APPLICATIVE with type 'a t := 'a t val return : 'a -> 'a t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t end +module type MONAD = sig + include MONAD_BARE + include APPLICATIVE with type 'a t := 'a t +end + module type MONAD_TRANSFORMER = sig include MONAD module M : MONAD @@ -76,8 +80,6 @@ module type TRAVERSE = functor(M : MONAD) -> sig val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t end -(** {2 Some Implementations} *) - module type FREE_MONAD = sig module F : FUNCTOR @@ -89,6 +91,19 @@ module type FREE_MONAD = sig val inj : 'a F.t -> 'a t end +(** {2 Some Implementations} *) + +module WrapMonad(M : MONAD_BARE) = struct + include M + + let map f x = x >>= (fun x -> return (f x)) + + let pure = return + + let (<*>) f x = f >>= fun f -> x >>= fun x -> return (f x) +end + + module MakeFree(F : FUNCTOR) = struct module F = F diff --git a/core/CCCat.mli b/core/CCCat.mli index 62b2ed76..1f136322 100644 --- a/core/CCCat.mli +++ b/core/CCCat.mli @@ -48,13 +48,17 @@ module type APPLICATIVE = sig val (<*>) : ('a -> 'b) t -> 'a t -> 'b t end -module type MONAD = sig +module type MONAD_BARE = sig type +'a t - include APPLICATIVE with type 'a t := 'a t val return : 'a -> 'a t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t end +module type MONAD = sig + include MONAD_BARE + include APPLICATIVE with type 'a t := 'a t +end + module type MONAD_TRANSFORMER = sig include MONAD module M : MONAD @@ -79,8 +83,6 @@ module type TRAVERSE = functor(M : MONAD) -> sig val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t end -(** {2 Some Implementations} *) - (** The free monad is built by nesting applications of a functor [F]. For instance, Lisp-like nested lists can be built and dealt with like this: @@ -100,6 +102,11 @@ module type FREE_MONAD = sig val inj : 'a F.t -> 'a t end +(** {2 Some Implementations} *) + +(** Implement the applicative and functor modules from only return and bind *) +module WrapMonad(M : MONAD_BARE) : MONAD with type 'a t = 'a M.t + module MakeFree(F : FUNCTOR) : FREE_MONAD with module F = F module MakeFreeFold(FM : FREE_MONAD)(Fold : FOLDABLE with type 'a t = 'a FM.F.t)