module Monad_example = struct module X : sig type 'a t module Let_syntax : sig val return : 'a -> 'a t val bind : 'a t -> ('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 module Open_in_body : sig val return : 'a -> 'a t 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 let bind = bind let map = map let both = both module Open_on_rhs = struct let return = return end module Open_in_body = struct let return = return end end end module Let_syntax = 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 = 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 end module Applicative_example = struct module X : sig type '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 module Open_in_body : sig 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 let map = map let both = both module Open_on_rhs = struct let flag = 66 let anon = 77 end module Open_in_body = struct end end end module Let_syntax = 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 Async_command_override_example = struct module Deferred : sig type 'a t val return : 'a -> 'a t module Let_syntax : sig module Let_syntax : sig type 'a t 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 return : 'a -> 'a t end module Open_in_body : sig val return : 'a -> 'a t end end with type 'a t := 'a t end end = struct type 'a t = 'a let return x = x module Let_syntax = struct module Let_syntax = struct let return = return let map x ~f = f x let both x y = (x, y) module Open_on_rhs = struct let return = return end module Open_in_body = struct let return = return end end end end module Command : sig module Param : sig type 'a t val return : 'a -> 'a t val flag : 'a -> int t val anon : 'a -> int t end module Let_syntax : sig module Let_syntax : sig type 'a t 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 = Param module Open_in_body : sig end end with type 'a t := 'a Param.t end end = struct module Param = struct type 'a t = 'a let return x = x let map x ~f = f x let both x y = (x, y) let flag _ = 66 let anon _ = 77 end module Let_syntax = struct module Let_syntax = struct include Param module Open_on_rhs = Param module Open_in_body = struct end end end end module Command_override = struct module Param = struct include Command.Param let special_flag = flag 88 end module Let_syntax = struct open Command.Let_syntax module Let_syntax = struct include (Let_syntax : module type of Let_syntax with module Open_on_rhs := Let_syntax.Open_on_rhs and module Open_in_body := Let_syntax.Open_in_body) module Open_on_rhs = Param module Open_in_body = Deferred.Let_syntax end end end let _1 : int Command.Param.t = let open Command.Let_syntax in [%map_open let x = flag "foo" and y = anon "bar" in x + y ] ;; let _1 : (unit -> int Deferred.t) Command_override.Param.t = let open Command_override.Let_syntax in [%map_open let x = flag "foo" and y = anon "bar" and z = special_flag in (fun () -> let%map () = Deferred.return () in x + y + z) ] ;; let _1 : (unit -> unit Deferred.t) Command.Param.t = let open Command_override.Let_syntax in [%map_open let () = return () in fun () -> let%map () = Deferred.return () in () ] ;; end