module Monad_example = struct module Let_syntax = struct let bind x ~f = f x module Open_on_rhs_bind = struct let return _ = "foo" end end let _mf a = let%bind xyz = return a in (int_of_string xyz + 1) ;; end (* TODO: re-enable some tests *) (* module Monad_example = struct module X : sig type 'a t module Let_syntax : sig val return : 'a -> 'a t module Let_syntax : sig val return : 'a -> 'a t val bind : 'a t -> f:('a -> 'b t) -> 'b t val map : 'a t -> f:('a -> 'b) -> 'b t val both : 'a t -> 'b t -> ('a * 'b) t module Open_on_rhs : sig val return : 'a -> 'a t end end end end = struct type 'a t = 'a let return x = x let bind x ~f = f x let map x ~f = f x let both x y = x, y module Let_syntax = struct let return = return module Let_syntax = struct let return = return let bind = bind let map = map let both = both module Open_on_rhs = struct let return = return end end end end open X.Let_syntax let _mf a : _ X.t = let%bind_open x = a in return (x + 1) ;; let _mf' a b c : _ X.t = let%bind_open x = a and y = b and u, v = c in return (x + y + (u * v)) ;; let _mg a : _ X.t = let%map x : int X.t = a in x + 1 ;; let _mg' a b c : _ X.t = let%map x = a and y = b and u, v = c in x + y + (u * v) ;; let _mh a : _ X.t = match%bind_open a with | 0 -> return true | _ -> return false ;; let _mi a : _ X.t = match%map a with | 0 -> true | _ -> false ;; let _mif a : _ X.t = if%bind_open a then return true else return false let _mif' a : _ X.t = if%map a then true else false end module Applicative_example = struct module X : sig type 'a t module Let_syntax : sig val return : 'a -> 'a t module Let_syntax : sig val return : 'a -> 'a t val map : 'a t -> f:('a -> 'b) -> 'b t val both : 'a t -> 'b t -> ('a * 'b) t module Open_on_rhs : sig val flag : int t val anon : int t end end end end = struct type 'a t = 'a let return x = x let map x ~f = f x let both x y = x, y module Let_syntax = struct let return = return module Let_syntax = struct let return = return let map = map let both = both module Open_on_rhs = struct let flag = 66 let anon = 77 end end end end open X.Let_syntax (* {[ let _af a : _ X.t = let%bind x = a in (* "Error: Unbound value Let_syntax.bind" *) return (x + 1) ]} *) (* {[ let _af' a b c : _ X.t = let%bind x = a and y = b and (u, v) = c in (* "Error: Unbound value Let_syntax.bind" *) return (x + y + (u * v)) ]} *) let _ag a : _ X.t = let%map x = a in x + 1 ;; let _ag' a b c : _ X.t = let%map x = a and y = b and u, v = c in x + y + (u * v) ;; (* {[ let _ah a : _ X.t = match%bind a with (* "Error: Unbound value Let_syntax.bind" *) | 0 -> return true | _ -> return false ]} *) let _ai a : _ X.t = match%map a with | 0 -> true | _ -> false ;; end module Example_without_open = struct let _ag a : _ Applicative_example.X.t = let%map.Applicative_example.X.Let_syntax x = a in x + 1 ;; end *)