- val run_exn : ('x,'a) m -> ('x,'a) result
- end
- module type S2 = sig
- include BASE2
- val (>>=) : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
- val (>>) : ('x,'a) m -> ('x,'b) m -> ('x,'b) m
- val join : ('x,('x,'a) m) m -> ('x,'a) m
- val apply : ('x,'a -> 'b) m -> ('x,'a) m -> ('x,'b) m
- val lift : ('a -> 'b) -> ('x,'a) m -> ('x,'b) m
- val lift2 : ('a -> 'b -> 'c) -> ('x,'a) m -> ('x,'b) m -> ('x,'c) m
- val (>=>) : ('a -> ('x,'b) m) -> ('b -> ('x,'c) m) -> 'a -> ('x,'c) m
- val do_when : bool -> ('x,unit) m -> ('x,unit) m
- val do_unless : bool -> ('x,unit) m -> ('x,unit) m
- val forever : ('x,'a) m -> ('x,'b) m
- val sequence : ('x,'a) m list -> ('x,'a list) m
- val sequence_ : ('x,'a) m list -> ('x,unit) m
- end
- module Make2(B : BASE2) : S2 with type ('x,'a) m = ('x,'a) B.m and type ('x,'a) result = ('x,'a) B.result and type ('x,'a) result_exn = ('x,'a) B.result_exn = struct
- include B
- let (>>=) = bind
- let (>>) u v = u >>= fun _ -> v
- let lift f u = u >>= fun a -> unit (f a)
- let join uu = uu >>= fun u -> u
- let apply u v = u >>= fun f -> v >>= fun a -> unit (f a)
- let lift2 f u v = u >>= fun a -> v >>= fun a' -> unit (f a a')
- let (>=>) f g = fun a -> f a >>= g
- let do_when test u = if test then u else unit ()
- let do_unless test u = if test then unit () else u
- let rec forever u = u >> forever u
- let sequence ms =
- let op u v = u >>= fun x -> v >>= fun xs -> unit (x :: xs) in
- Util.fold_right op ms (unit [])
- let sequence_ ms =
- Util.fold_right (>>) ms (unit ())
- end
-
- (* Signatures for MonadT *)
- module type W = sig
- include S
- end
- module type WP = sig
- include W
- val zero : unit -> 'a m
- val plus : 'a m -> 'a m -> 'a m
- end
- module type TRANS = sig
- type 'a m
- val bind : 'a m -> ('a -> 'b m) -> 'b m
- module Wrapped : W
- type 'a result
- val run : 'a m -> 'a result
- type 'a result_exn
- val run_exn : 'a m -> 'a result_exn
- val elevate : 'a Wrapped.m -> 'a m