metaocaml monad

metaocamltest.ml

module M : sig
  type 'a t
  val return : 'a code -> 'a t
  val (>>=) : 'a t -> ('a code -> 'b t) -> 'b t
  val go : unit t -> unit code
end = struct
  type 'a t = ('a -> unit) code -> unit code
  let return = fun a k -> .< .~k .~a  >.
  let (>>=) m f = fun k -> .< .~(m .< fun x -> .~(f .< x >. k) >. )  >.
  let go : unit t -> unit code = fun m -> m .< fun () -> () >.
end

open M

let m =
  return .< 10 >. >>= fun x ->
  return .< 20 >. >>= fun y ->
  return .< print_int (.~x + .~y) >.
;;
  
Runcode.run (go m);;



(* module M : sig *)
(*   type ('p, 'q, 'a) t *)
(*   val return : 'a code -> ('p, 'p, 'a) t *)
(*   val (>>=) : ('p, 'q, 'a) t -> ('a code -> ('q, 'r, 'b) t) -> ('p, 'r, 'b) t *)
(* end = struct *)
(*   type ('p,'q,'a) t = ('a -> 'p) code -> 'q code *)
(*   let return = fun a k -> .< .~k .~a  >. *)
(*   let (>>=) m f = fun k -> .< .~(m .< fun x -> .~(f .< x >. k) >. )  >. *)
(* end *)