From 874454e38952d581b7dfa38840e46b89ad3d18ac Mon Sep 17 00:00:00 2001
From: Ivan Gotovchits <ivg@ieee.org>
Date: Tue, 10 Nov 2020 08:41:48 -0500
Subject: [PATCH] adds binding operators to the monads library (#1234)

Instead of extending the `Syntax` module of the `Monad.S` and
`Monad.S2` interface, which will break the interfaces, we add a new
module `Let` which includes binding operators for Monadic and
applicative interfaces (`let*`/`and*` and `let+`/`and+`
correspondingly).

That means that in order to be able to use the monadic operators for
the monad `Example` we need to open either `Example` or `Example.Let`
first, so we can write

```
open Example.Let

let example x y =
  let* r = compute x in
  let+ s = compute y in
  r + s
```

instead of the old style with `fun`,

```
open Example.Syntax

let example x y =
  compute x >>= fun r ->
  compute y >>| fun s ->
  r + s
```

Parallel binding is provided via the `(and*)` and `(and+)` operators,
so it is possible to write

```
open Example.Let

let example x y =
  let* r = compute x in
  and* s = compute y in
  Example.return (r + s)
```
---
 lib/monads/monads.mli      | 69 ++++++++++++++++++++++++++++++++++++--
 lib/monads/monads_monad.ml | 24 +++++++++++++
 lib/monads/monads_types.ml | 22 ++++++++++++
 3 files changed, 112 insertions(+), 3 deletions(-)

diff --git a/lib/monads/monads.mli b/lib/monads/monads.mli
index eb52be410..52088771c 100644
--- a/lib/monads/monads.mli
+++ b/lib/monads/monads.mli
@@ -203,7 +203,8 @@ open Core_kernel
     To use the library add [open Monads.Std] to your program. It will
     bring [Monoid] and [Monad] modules to your scope. A conventional
     way of writing a computation in a monad [M], is to open its syntax
-    with [open M.Syntax].
+    with [open M.Syntax] and/or [open M.Let] (for the monadic binding
+    operators).
 
     Given that monad is a concept that goes beyond OCaml language,
     i.e., it is more a design pattern rather than just a module type
@@ -982,6 +983,8 @@ module Std : sig
         val (!$$$$$) : ('a -> 'b -> 'c -> 'd -> 'e -> 'f) -> ('a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t)
       end
 
+
+      (** Operators for binary monad.  *)
       module type S2 = sig
         type ('a,'e) t
 
@@ -1013,9 +1016,61 @@ module Std : sig
         val (!$$$$$) : ('a -> 'b -> 'c -> 'd -> 'e -> 'f) ->
           (('a,'s) t -> ('b,'s) t -> ('c,'s) t -> ('d,'s) t -> ('e,'s) t -> ('f,'s) t)
       end
+
+
+      (** Monadic bindings operators.
+
+          This operators allows to write
+
+          {[let* r = computation x in body]}
+
+          instead of the old infix style
+
+          {[computation x >>= fun r -> body]}
+
+          The [let*] and [and*] operators stand for the monad
+          part of the binding operators interface and [let+] with [and+]
+          stand for the applicative part of the binding operators
+          interface.
+
+          @since 2.2.0 and OCaml 4.08.0
+      *)
+      module Let : sig
+        module type S = sig
+          type 'a t
+
+          (** [let* r = f x in b] is [f x >>= fun r -> b]  *)
+          val (let*) : 'a t -> ('a -> 'b t) -> 'b t
+
+          (** monoidal product  *)
+          val (and*) : 'a t -> 'b t -> ('a * 'b) t
+
+          (** [let+ r = f x in b] is [f x >>| fun r -> b]  *)
+          val (let+) : 'a t -> ('a -> 'b) -> 'b t
+
+          (** monoidal product  *)
+          val (and+) : 'a t -> 'b t -> ('a * 'b) t
+        end
+
+        module type S2 = sig
+          type ('a,'e) t
+
+          (** [let* r = f x in b] is [f x >>= fun r -> b]  *)
+          val (let*) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t
+
+          (** monoidal product  *)
+          val (and*) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t
+
+          (** [let+ r = f x in b] is [f x >>| fun r -> b]  *)
+          val (let+) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t
+
+          (** monoidal product  *)
+          val (and+) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t
+        end
+      end
     end
 
-    (** An unary monad interface.  *)
+    (** A unary monad interface.  *)
     module type S = sig
       type 'a t
 
@@ -1146,8 +1201,9 @@ module Std : sig
       module Seq : Collection.S with type 'a t := 'a Sequence.t
 
       include Syntax.S with type 'a t := 'a t
+      include Syntax.Let.S with type 'a t := 'a t
       include Monad.S with type 'a t := 'a t
-
+      module Let : Syntax.Let.S with type 'a t := 'a t
       (** Monadic operators, see
           {{!Std.Monad.Syntax.S}Monad.Syntax.S} for more.  *)
       module Syntax : Syntax.S with type 'a t := 'a t
@@ -1287,8 +1343,15 @@ module Std : sig
       module Seq : Collection.S with type 'a t := 'a Sequence.t
 
       include Syntax.S2 with type ('a,'e) t := ('a,'e) t
+      include Syntax.Let.S2 with type ('a,'e) t := ('a,'e) t
       include Monad.S2 with type ('a,'e) t := ('a,'e) t
 
+
+      (** Monadic Binding Operators.
+          @since 2.2.0
+      *)
+      module Let : Syntax.Let.S2 with type ('a,'e) t := ('a,'e) t
+
       (** Monadic operators, see
           {{!Std.Monad.Syntax.S2}Monad.Syntax.S2} for more.  *)
       module Syntax : Syntax.S2 with type ('a,'e) t := ('a,'e) t
diff --git a/lib/monads/monads_monad.ml b/lib/monads/monads_monad.ml
index 48d156646..177fcbeb4 100644
--- a/lib/monads/monads_monad.ml
+++ b/lib/monads/monads_monad.ml
@@ -82,6 +82,17 @@ module Monad = struct
       include Lift.Syntax
       let (>=>) g f = Fn.compose f g [@@inline]
     end
+
+    module Let = struct
+      let (let*) = (>>=)
+      let (let+) = (>>|)
+      let (and+) x y =
+        x >>= fun x ->
+        y >>| fun y ->
+        (x,y)
+      let (and*) = (and+)
+    end
+
     open Syntax
 
     module Pair = struct
@@ -252,6 +263,7 @@ module Monad = struct
     let sequence = List.sequence
     let rec forever t = bind t (fun _ -> forever t)
     include Syntax
+    include Let
   end
 
   module Make(M : B) : S with type 'a t := 'a M.t =
@@ -433,6 +445,17 @@ module Ident
     let (!$$$$$) = ident
   end
 
+  module Let = struct
+    open Syntax
+    let (let*) = (>>=)
+    let (let+) = (>>|)
+    let (and+) x y =
+      x >>= fun x ->
+      y >>| fun y ->
+      (x,y)
+    let (and*) = (and+)
+  end
+
   module Let_syntax = struct
     include Syntax
     let return = ident
@@ -457,6 +480,7 @@ module Ident
   module Monad_infix = Syntax
   include Let_syntax.Let_syntax
   include Syntax
+  include Let
 end
 
 module OptionT = struct
diff --git a/lib/monads/monads_types.ml b/lib/monads/monads_types.ml
index fe000ee0b..d9ded8e85 100644
--- a/lib/monads/monads_types.ml
+++ b/lib/monads/monads_types.ml
@@ -218,6 +218,24 @@ module Monad = struct
       val (!$$$$$) : ('a -> 'b -> 'c -> 'd -> 'e -> 'f) ->
         (('a,'s) t -> ('b,'s) t -> ('c,'s) t -> ('d,'s) t -> ('e,'s) t -> ('f,'s) t)
     end
+
+    module Let = struct
+      module type S = sig
+        type 'a t
+        val (let*) : 'a t -> ('a -> 'b t) -> 'b t
+        val (and*) : 'a t -> 'b t -> ('a * 'b) t
+        val (let+) : 'a t -> ('a -> 'b) -> 'b t
+        val (and+) : 'a t -> 'b t -> ('a * 'b) t
+      end
+
+      module type S2 = sig
+        type ('a,'e) t
+        val (let*) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t
+        val (and*) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t
+        val (let+) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t
+        val (and+) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t
+      end
+    end
   end
 
   module type S = sig
@@ -271,7 +289,9 @@ module Monad = struct
 
 
     include Syntax.S with type 'a t := 'a t
+    include Syntax.Let.S with type 'a t := 'a t
     include Monad.S with type 'a t := 'a t
+    module Let : Syntax.Let.S with type 'a t := 'a t
     module Syntax : Syntax.S with type 'a t := 'a t
   end
 
@@ -330,7 +350,9 @@ module Monad = struct
 
 
     include Syntax.S2 with type ('a,'e) t := ('a,'e) t
+    include Syntax.Let.S2 with type ('a,'e) t := ('a,'e) t
     include Monad.S2 with type ('a,'e) t := ('a,'e) t
+    module Let : Syntax.Let.S2 with type ('a,'e) t := ('a,'e) t
     module Syntax : Syntax.S2 with type ('a,'e) t := ('a,'e) t
   end
 end