190 lines
3.5 KiB
OCaml
190 lines
3.5 KiB
OCaml
|
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
|
||
|
*)
|