113.43+70

META.ab

@@ -1,6 +1,6 @@
 version = "$(pkg_version)"
 description = "Monadic let-bindings"
-requires = "ppx_core ppx_driver"
+requires = "compiler-libs.common ppx_core ppx_driver"
 archive(ppx_driver, byte  ) = "ppx_let.cma"
 archive(ppx_driver, native) = "ppx_let.cmxa"
 plugin(ppx_driver, byte  ) = "ppx_let.cma"

Makefile

@@ -2,7 +2,7 @@
 
 SETUP := setup.exe
 NAME := ppx_let
-PREFIX = $(shell grep ^prefix= setup.data | cut -d\" -f 2)
+PREFIX ?= $(shell grep ^prefix= setup.data | cut -d\" -f 2)
 
 # Default rule
 default: build

README.md

@@ -132,25 +132,18 @@ module Let_syntax : sig
   val map    : 'a t -> f:('a -> 'b) -> 'b t
   val both   : 'a t -> 'b t -> ('a * 'b) t
   module Open_on_rhs : << some signature >>
-  module Open_in_body : << some signature >>
 end
 ```
 
-The `Open_on_rhs` and `Open_in_body` submodules are used by variants
+The `Open_on_rhs` submodule is used by variants of `%map` and `%bind`
-of `%map` and `%bind` called `%map_open` and `%bind_open`.
+called `%map_open` and `%bind_open`.  It is locally opened on the
+right hand sides of the rewritten let bindings in `%map_open` and
+`%bind_open` expressions.  For `match%map_open` and `match%bind_open`
+expressions, `Open_on_rhs` is opened for the expression being matched
+on.
 
-The `Open_on_rhs` submodule is locally opened on the right hand sides
+`Open_on_rhs` is useful when programming with applicatives, which
-of the rewritten let bindings in `%map_open` and `%bind_open`
-expressions.  This is useful when programming with applicatives, which
 operate in a staged manner where the operators used to construct the
 applicatives are distinct from the operators used to manipulate the
 values those applicatives produce.  For monads, `Open_on_rhs` contains
 `return`.
-
-The `Open_in_body` submodule is locally opened in the body of either a
-`let%map_open` or `let%bind_open`.  It is often empty for
-applicatives.  For monads in `Core`, it contains `return`.
-
-For `match%map_open` and `match%bind_open` expressions, `Open_on_rhs`
-is opened for the expression being matched on, and `Open_in_body` is
-opened in the body of each pattern match clause.

_oasis

@@ -2,7 +2,7 @@ OASISFormat:           0.4
 OCamlVersion:          >= 4.02.3
 FindlibVersion:        >= 1.3.2
 Name:                  ppx_let
-Version:               113.33.03
+Version:               113.43+70
 Synopsis:              Monadic let-bindings
 Authors:               Jane Street Group, LLC <opensource@janestreet.com>
 Copyrights:            (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
@@ -25,7 +25,8 @@ Library ppx_let
   Path:         src
   Pack:         false
   Modules:      Ppx_let
-  BuildDepends: ppx_core,
+  BuildDepends: compiler-libs.common,
+                ppx_core,
                 ppx_driver
 
 Executable ppx

src/ppx_let.ml

@@ -33,7 +33,6 @@ end
 let let_syntax = "Let_syntax"
 
 let open_on_rhs  ~loc = Located.mk ~loc (Longident.Ldot (Lident let_syntax, "Open_on_rhs" ))
-let open_in_body ~loc = Located.mk ~loc (Longident.Ldot (Lident let_syntax, "Open_in_body"))
 
 let eoperator ~loc func =
   let lid : Longident.t = Ldot (Longident.Lident let_syntax, func) in
@@ -90,17 +89,10 @@ let expand_let extension_name ~loc bindings body =
       ppat_tuple ~loc [p; acc])
   in
   bind_apply ~loc extension_name ~arg:nested_boths
-    ~fn:(pexp_fun ~loc "" None nested_patterns
+    ~fn:(pexp_fun ~loc "" None nested_patterns body)
-           (maybe_open extension_name ~to_open:open_in_body body))
 ;;
 
 let expand_match extension_name ~loc expr cases =
-  let cases =
-    List.map cases ~f:(fun case ->
-      { case with
-        pc_rhs = maybe_open extension_name ~to_open:open_in_body case.pc_rhs;
-      })
-  in
   bind_apply ~loc extension_name
     ~arg:(maybe_open extension_name ~to_open:open_on_rhs expr)
     ~fn:(pexp_function ~loc cases)
@@ -132,7 +124,7 @@ let expand ~loc:_ ~path:_ extension_name expr =
 ;;
 
 let ext extension_name =
-  Extension.V2.declare
+  Extension.declare
     (Extension_name.to_string extension_name)
     Extension.Context.expression
     Ast_pattern.(single_expr_payload __)

test/test-locations.mlt

@@ -8,7 +8,6 @@ module Let_syntax = struct
     let return x = T x
     let f x ~(doc:string) = T (x, doc)
   end
-  module Open_in_body = struct end
 end
 
 let _ = [%map_open let x = return 42 and y = f 42 in ()]

test/test.ml

@@ -4,11 +4,13 @@ module Monad_example = struct
     type 'a t
     module Let_syntax : sig
       val return : 'a -> 'a t
-      val bind   : 'a t -> ('a -> 'b t) -> 'b t
+      module Let_syntax : sig
-      val map    : 'a t -> f:('a -> 'b) -> 'b t
+        val return : 'a -> 'a t
-      val both   : 'a t -> 'b t -> ('a * 'b) t
+        val bind   : 'a t -> ('a -> 'b t) -> 'b t
-      module Open_on_rhs  : sig val return : 'a -> 'a t end
+        val map    : 'a t -> f:('a -> 'b) -> 'b t
-      module Open_in_body : sig val return : 'a -> 'a t end
+        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
@@ -18,15 +20,17 @@ module Monad_example = struct
     let both x y = (x, y)
     module Let_syntax = struct
       let return = return
-      let bind   = bind
+      module Let_syntax = struct
-      let map    = map
+        let return = return
-      let both   = both
+        let bind   = bind
-      module Open_on_rhs  = struct let return = return end
+        let map    = map
-      module Open_in_body = struct let return = return end
+        let both   = both
+        module Open_on_rhs  = struct let return = return end
+      end
     end
   end
 
-  module Let_syntax = X.Let_syntax
+  open X.Let_syntax
 
   let _mf a : _ X.t =
     let%bind_open x = a in
@@ -61,13 +65,15 @@ module Applicative_example = struct
     type 'a t
     module Let_syntax : sig
       val return : 'a -> 'a t
-      val map    : 'a t -> f:('a -> 'b) -> 'b t
+      module Let_syntax : sig
-      val both   : 'a t -> 'b t -> ('a * 'b) t
+        val return : 'a -> 'a t
-      module Open_on_rhs : sig
+        val map    : 'a t -> f:('a -> 'b) -> 'b t
-        val flag : int t
+        val both   : 'a t -> 'b t -> ('a * 'b) t
-        val anon : int t
+        module Open_on_rhs : sig
+          val flag : int t
+          val anon : int t
+        end
       end
-      module Open_in_body : sig end
     end
   end = struct
     type 'a t = 'a
@@ -76,17 +82,19 @@ module Applicative_example = struct
     let both x y = (x, y)
     module Let_syntax = struct
       let return = return
-      let map    = map
+      module Let_syntax = struct
-      let both   = both
+        let return = return
-      module Open_on_rhs = struct
+        let map    = map
-        let flag = 66
+        let both   = both
-        let anon = 77
+        module Open_on_rhs = struct
+          let flag = 66
+          let anon = 77
+        end
       end
-      module Open_in_body = struct end
     end
   end
 
-  module Let_syntax = X.Let_syntax
+  open X.Let_syntax
 
   (* {[
        let _af a : _ X.t =
@@ -120,119 +128,3 @@ module Applicative_example = struct
     | 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