- 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 : (unit -> ('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
- (* code repetition, ugh *)
- 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 forever uthunk =
- let rec loop () = uthunk () >>= fun _ -> loop ()
- in loop ()
- 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
-
- module type PLUSBASE2 = sig
- include BASE2
- val zero : unit -> ('x,'a) m
- val plus : ('x,'a) m -> ('x,'a) m -> ('x,'a) m
- end
- module type PLUS2 = sig
- type ('x,'a) m