diff --git a/sledge/src/import/import.ml b/sledge/src/import/import.ml index ee33ee883..6ace550db 100644 --- a/sledge/src/import/import.ml +++ b/sledge/src/import/import.ml @@ -134,6 +134,20 @@ let map_preserving_phys_equal map t ~f = in if !change then t' else t +module type Applicative_syntax = sig + type 'a t + + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t +end + +module type Monad_syntax = sig + include Applicative_syntax + + val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t + val ( and* ) : 'a t -> 'b t -> ('a * 'b) t +end + module Option = struct include Base.Option @@ -142,9 +156,19 @@ module Option = struct | None -> () let cons xo xs = match xo with Some x -> x :: xs | None -> xs + + module Monad_syntax = struct + type nonrec 'a t = 'a t + + let ( let+ ) x f = map ~f x + let ( and+ ) x y = both x y + let ( let* ) x f = bind ~f x + let ( and* ) x y = both x y + end end include Option.Monad_infix +include Option.Monad_syntax module List = struct include Base.List diff --git a/sledge/src/import/import.mli b/sledge/src/import/import.mli index 5ea7f24fd..8de11cbda 100644 --- a/sledge/src/import/import.mli +++ b/sledge/src/import/import.mli @@ -105,6 +105,20 @@ val or_error : ('a -> 'b) -> 'a -> unit -> 'b or_error module Invariant : module type of Base.Invariant +module type Applicative_syntax = sig + type 'a t + + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t +end + +module type Monad_syntax = sig + include Applicative_syntax + + val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t + val ( and* ) : 'a t -> 'b t -> ('a * 'b) t +end + module Option : sig include module type of Base.Option @@ -112,9 +126,12 @@ module Option : sig (** Pretty-print an option. *) val cons : 'a t -> 'a list -> 'a list + + module Monad_syntax : Monad_syntax end include module type of Option.Monad_infix +include module type of Option.Monad_syntax with type 'a t = 'a option module List : sig include module type of Base.List