113.24.00

.gitignore

@@ -0,0 +1,7 @@
+_build/
+/setup.data
+/setup.log
+/*.exe
+/*.docdir
+/*.native
+/*.byte

INRIA-DISCLAIMER.txt

@@ -0,0 +1,12 @@
+THIS SOFTWARE IS PROVIDED BY INRIA AND CONTRIBUTORS "AS IS" AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL INRIA OR ITS CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+

LICENSE.txt

@@ -0,0 +1,202 @@
+
+                                 Apache License
+                           Version 2.0, January 2004
+                        http://www.apache.org/licenses/
+
+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+   1. Definitions.
+
+      "License" shall mean the terms and conditions for use, reproduction,
+      and distribution as defined by Sections 1 through 9 of this document.
+
+      "Licensor" shall mean the copyright owner or entity authorized by
+      the copyright owner that is granting the License.
+
+      "Legal Entity" shall mean the union of the acting entity and all
+      other entities that control, are controlled by, or are under common
+      control with that entity. For the purposes of this definition,
+      "control" means (i) the power, direct or indirect, to cause the
+      direction or management of such entity, whether by contract or
+      otherwise, or (ii) ownership of fifty percent (50%) or more of the
+      outstanding shares, or (iii) beneficial ownership of such entity.
+
+      "You" (or "Your") shall mean an individual or Legal Entity
+      exercising permissions granted by this License.
+
+      "Source" form shall mean the preferred form for making modifications,
+      including but not limited to software source code, documentation
+      source, and configuration files.
+
+      "Object" form shall mean any form resulting from mechanical
+      transformation or translation of a Source form, including but
+      not limited to compiled object code, generated documentation,
+      and conversions to other media types.
+
+      "Work" shall mean the work of authorship, whether in Source or
+      Object form, made available under the License, as indicated by a
+      copyright notice that is included in or attached to the work
+      (an example is provided in the Appendix below).
+
+      "Derivative Works" shall mean any work, whether in Source or Object
+      form, that is based on (or derived from) the Work and for which the
+      editorial revisions, annotations, elaborations, or other modifications
+      represent, as a whole, an original work of authorship. For the purposes
+      of this License, Derivative Works shall not include works that remain
+      separable from, or merely link (or bind by name) to the interfaces of,
+      the Work and Derivative Works thereof.
+
+      "Contribution" shall mean any work of authorship, including
+      the original version of the Work and any modifications or additions
+      to that Work or Derivative Works thereof, that is intentionally
+      submitted to Licensor for inclusion in the Work by the copyright owner
+      or by an individual or Legal Entity authorized to submit on behalf of
+      the copyright owner. For the purposes of this definition, "submitted"
+      means any form of electronic, verbal, or written communication sent
+      to the Licensor or its representatives, including but not limited to
+      communication on electronic mailing lists, source code control systems,
+      and issue tracking systems that are managed by, or on behalf of, the
+      Licensor for the purpose of discussing and improving the Work, but
+      excluding communication that is conspicuously marked or otherwise
+      designated in writing by the copyright owner as "Not a Contribution."
+
+      "Contributor" shall mean Licensor and any individual or Legal Entity
+      on behalf of whom a Contribution has been received by Licensor and
+      subsequently incorporated within the Work.
+
+   2. Grant of Copyright License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      copyright license to reproduce, prepare Derivative Works of,
+      publicly display, publicly perform, sublicense, and distribute the
+      Work and such Derivative Works in Source or Object form.
+
+   3. Grant of Patent License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      (except as stated in this section) patent license to make, have made,
+      use, offer to sell, sell, import, and otherwise transfer the Work,
+      where such license applies only to those patent claims licensable
+      by such Contributor that are necessarily infringed by their
+      Contribution(s) alone or by combination of their Contribution(s)
+      with the Work to which such Contribution(s) was submitted. If You
+      institute patent litigation against any entity (including a
+      cross-claim or counterclaim in a lawsuit) alleging that the Work
+      or a Contribution incorporated within the Work constitutes direct
+      or contributory patent infringement, then any patent licenses
+      granted to You under this License for that Work shall terminate
+      as of the date such litigation is filed.
+
+   4. Redistribution. You may reproduce and distribute copies of the
+      Work or Derivative Works thereof in any medium, with or without
+      modifications, and in Source or Object form, provided that You
+      meet the following conditions:
+
+      (a) You must give any other recipients of the Work or
+          Derivative Works a copy of this License; and
+
+      (b) You must cause any modified files to carry prominent notices
+          stating that You changed the files; and
+
+      (c) You must retain, in the Source form of any Derivative Works
+          that You distribute, all copyright, patent, trademark, and
+          attribution notices from the Source form of the Work,
+          excluding those notices that do not pertain to any part of
+          the Derivative Works; and
+
+      (d) If the Work includes a "NOTICE" text file as part of its
+          distribution, then any Derivative Works that You distribute must
+          include a readable copy of the attribution notices contained
+          within such NOTICE file, excluding those notices that do not
+          pertain to any part of the Derivative Works, in at least one
+          of the following places: within a NOTICE text file distributed
+          as part of the Derivative Works; within the Source form or
+          documentation, if provided along with the Derivative Works; or,
+          within a display generated by the Derivative Works, if and
+          wherever such third-party notices normally appear. The contents
+          of the NOTICE file are for informational purposes only and
+          do not modify the License. You may add Your own attribution
+          notices within Derivative Works that You distribute, alongside
+          or as an addendum to the NOTICE text from the Work, provided
+          that such additional attribution notices cannot be construed
+          as modifying the License.
+
+      You may add Your own copyright statement to Your modifications and
+      may provide additional or different license terms and conditions
+      for use, reproduction, or distribution of Your modifications, or
+      for any such Derivative Works as a whole, provided Your use,
+      reproduction, and distribution of the Work otherwise complies with
+      the conditions stated in this License.
+
+   5. Submission of Contributions. Unless You explicitly state otherwise,
+      any Contribution intentionally submitted for inclusion in the Work
+      by You to the Licensor shall be under the terms and conditions of
+      this License, without any additional terms or conditions.
+      Notwithstanding the above, nothing herein shall supersede or modify
+      the terms of any separate license agreement you may have executed
+      with Licensor regarding such Contributions.
+
+   6. Trademarks. This License does not grant permission to use the trade
+      names, trademarks, service marks, or product names of the Licensor,
+      except as required for reasonable and customary use in describing the
+      origin of the Work and reproducing the content of the NOTICE file.
+
+   7. Disclaimer of Warranty. Unless required by applicable law or
+      agreed to in writing, Licensor provides the Work (and each
+      Contributor provides its Contributions) on an "AS IS" BASIS,
+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+      implied, including, without limitation, any warranties or conditions
+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+      PARTICULAR PURPOSE. You are solely responsible for determining the
+      appropriateness of using or redistributing the Work and assume any
+      risks associated with Your exercise of permissions under this License.
+
+   8. Limitation of Liability. In no event and under no legal theory,
+      whether in tort (including negligence), contract, or otherwise,
+      unless required by applicable law (such as deliberate and grossly
+      negligent acts) or agreed to in writing, shall any Contributor be
+      liable to You for damages, including any direct, indirect, special,
+      incidental, or consequential damages of any character arising as a
+      result of this License or out of the use or inability to use the
+      Work (including but not limited to damages for loss of goodwill,
+      work stoppage, computer failure or malfunction, or any and all
+      other commercial damages or losses), even if such Contributor
+      has been advised of the possibility of such damages.
+
+   9. Accepting Warranty or Additional Liability. While redistributing
+      the Work or Derivative Works thereof, You may choose to offer,
+      and charge a fee for, acceptance of support, warranty, indemnity,
+      or other liability obligations and/or rights consistent with this
+      License. However, in accepting such obligations, You may act only
+      on Your own behalf and on Your sole responsibility, not on behalf
+      of any other Contributor, and only if You agree to indemnify,
+      defend, and hold each Contributor harmless for any liability
+      incurred by, or claims asserted against, such Contributor by reason
+      of your accepting any such warranty or additional liability.
+
+   END OF TERMS AND CONDITIONS
+
+   APPENDIX: How to apply the Apache License to your work.
+
+      To apply the Apache License to your work, attach the following
+      boilerplate notice, with the fields enclosed by brackets "[]"
+      replaced with your own identifying information. (Don't include
+      the brackets!)  The text should be enclosed in the appropriate
+      comment syntax for the file format. We also recommend that a
+      file or class name and description of purpose be included on the
+      same "printed page" as the copyright notice for easier
+      identification within third-party archives.
+
+   Copyright [yyyy] [name of copyright owner]
+
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
+
+       http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.

META.ab

@@ -0,0 +1,8 @@
+version = "$(pkg_version)"
+description = "Monadic let-bindings"
+requires = "ppx_core ppx_driver"
+archive(ppx_driver, byte          ) = "ppx_let.cma"
+archive(ppx_driver, native        ) = "ppx_let.cmxa"
+archive(ppx_driver, native, plugin) = "ppx_let.cmxs"
+exists_if = "ppx_let.cma"
+ppx(-ppx_driver) = "./ppx"

Makefile

@@ -0,0 +1,68 @@
+# Generic Makefile for oasis project
+
+SETUP := setup.exe
+NAME := ppx_let
+PREFIX = $(shell grep ^prefix= setup.data | cut -d\" -f 2)
+
+# Default rule
+default: build
+
+setup.exe: _oasis setup.ml
+	ocamlfind ocamlopt -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup.ml || \
+	  ocamlfind ocamlc -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup.ml || true
+	for f in setup.*; do [ $$f = $@ -o $$f = setup.ml ] || rm -f $$f; done
+
+build: $(SETUP) setup.data
+	./$(SETUP) -build $(BUILDFLAGS)
+	$(MAKE) $(NAME).install
+
+doc: $(SETUP) setup.data build
+	./$(SETUP) -doc $(DOCFLAGS)
+
+test: $(SETUP) setup.data build
+	./$(SETUP) -test $(TESTFLAGS)
+
+all: $(SETUP)
+	./$(SETUP) -all $(ALLFLAGS)
+	$(MAKE) $(NAME).install
+
+$(NAME).install: js-utils/gen_install.ml setup.log setup.data
+	ocaml -I js-utils js-utils/gen_install.ml
+
+install: $(NAME).install
+	opam-installer -i --prefix $(PREFIX) $(NAME).install
+
+uninstall: $(NAME).install
+	opam-installer -u --prefix $(PREFIX) $(NAME).install
+
+reinstall: $(NAME).install
+	opam-installer -u --prefix $(PREFIX) $(NAME).install &> /dev/null || true
+	opam-installer -i --prefix $(PREFIX) $(NAME).install
+
+bin.tar.gz: $(NAME).install
+	rm -rf _install
+	mkdir _install
+	opam-installer -i --prefix _install $(NAME).install
+	tar czf bin.tar.gz -C _install .
+	rm -rf _install
+
+bin.lzo: $(NAME).install
+	rm -rf _install
+	mkdir _install
+	opam-installer -i --prefix _install $(NAME).install
+	cd _install && lzop -1 -P -o ../bin.lzo `find . -type f`
+	rm -rf _install
+
+clean: $(SETUP)
+	./$(SETUP) -clean $(CLEANFLAGS)
+
+distclean: $(SETUP)
+	./$(SETUP) -distclean $(DISTCLEANFLAGS)
+
+configure: $(SETUP)
+	./$(SETUP) -configure $(CONFIGUREFLAGS)
+
+setup.data: $(SETUP)
+	./$(SETUP) -configure $(CONFIGUREFLAGS)
+
+.PHONY: default build doc test all install uninstall reinstall clean distclean configure

README.md

@@ -0,0 +1,156 @@
+A ppx rewriter for monadic and applicative let bindings and match statements.
+
+Overview
+--------
+
+The aim of this rewriter is to make monadic and applicative code look
+nicer by writing custom binders the same way that we normally bind
+variables. In OCaml, the common way to bind the result of a
+computation to a variable is:
+
+```ocaml
+let VAR = EXPR in BODY
+```
+
+ppx\_let simply adds two new binders: `let%bind` and
+`let%map`. These are rewritten into calls to the `bind` and
+`map` functions respectively.  These functions are expected to have
+
+```ocaml
+val map : 'a t -> f:('a -> 'b) -> 'b t
+val bind : 'a t -> ('a -> 'b t) -> 'b t
+```
+
+for some type `t`, as one might expect.
+
+These functions are to be provided by the user, and are generally
+expected to be part of the signatures of monads and applicatives
+modules.  This is the case for all monads and applicatives defined by
+the Jane Street's Core suite of libraries. (see the section below on
+getting the right names into scope).
+
+### Parallel bindings
+
+ppx\_monad understands parallel bindings as well. i.e.:
+
+```ocaml
+let%bind VAR1 = EXPR1 and VAR2 = EXPR2 and VAR3 = EXPR3 in BODY
+```
+
+The `and` keyword is seen as a binding combination operator. To do so
+it expects the presence of a `both` function, that lifts the OCaml
+pair operation to the type `t` in question:
+
+```ocaml
+val both : 'a t -> 'b t -> ('a * 'b) t
+```
+
+### Match statements
+
+We found that this form was quite useful for match statements as
+well. So for convenience ppx\_monad also accept `%bind` and `%map` on
+the `match` keyword. Morally `match%bind expr with cases` is seen as
+`let%bind x = expr in match x with cases`.
+
+Syntactic forms and actual rewriting
+------------------------------------
+
+`ppx_let` adds four syntactic forms
+
+```ocaml
+let%bind P = M in E
+
+let%map P = M in E
+
+match%bind M with P1 -> E1 | P2 -> E2 | ...
+
+match%map M with P1 -> E1 | P2 -> E2 | ...
+```
+
+that expand into
+
+```ocaml
+bind M (fun P -> E)
+
+map M (fun P -> E)
+
+bind M (function P1 -> E1 | P2 -> E2 | ...)
+
+map M (function P1 -> E1 | P2 -> E2 | ...)
+```
+
+respectively.
+
+As with `let`, `let%bind` and `let%map` also support multiple
+*parallel* bindings via the `and` keyword:
+
+```ocaml
+let%bind P1 = M1 and P2 = M2 and P3 = M3 and P4 = M4 in E
+
+let%map P1 = M1 and P2 = M2 and P3 = M3 and P4 = M4 in E
+```
+
+that expand into
+
+```ocaml
+let x1 = M1 and x2 = M2 and x3 = M3 and x4 = M4 in
+bind
+  (both x1 (both x2 (both x3 x4)))
+  (fun (P1, (P2, (P3, P4))) -> E)
+
+let x1 = M1 and x2 = M2 and x3 = M3 and x4 = M4 in
+map
+  (both x1 (both x2 (both x3 x4)))
+  (fun (P1, (P2, (P3, P4))) -> E)
+```
+
+respectively. (Instead of `x1`, `x2`, ... ppx\_monad uses
+variable names that are unlikely to clash with other names)
+
+As with `let`, names introduced by left-hand sides of the let bindings
+are not available in subsequent right-hand sides of the same sequence.
+
+Getting the right names in scope
+--------------------------------
+
+The description of how the `%bind` and `%map` syntax extensions expand
+left out the fact that the names `bind`, `map`, `both`, and `return`
+are not used directly, but rather qualified by `Let_syntax`.  For
+example, we use `Let_syntax.bind` rather than merely `bind`.  This
+means one just needs to get a properly loaded `Let_syntax` module in
+scope to use `%bind` and `%map`.
+
+For monads, `Core.Std.Monad.Make` produces a submodule `Let_syntax` of
+the appropriate form.
+
+For applicatives.  The convention for these modules is to have a
+submodule `Let_syntax` of the form
+
+```ocaml
+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 : << some signature >>
+  module Open_in_body : << some signature >>
+end
+```
+
+The `Open_on_rhs` and `Open_in_body` submodules are used by variants
+of `%map` and `%bind` called `%map_open` and `%bind_open`.
+
+The `Open_on_rhs` submodule is locally opened on the right hand sides
+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.

THIRD-PARTY.txt

@@ -0,0 +1,18 @@
+The repository contains 3rd-party code in the following locations and
+under the following licenses:
+
+- type_conv, sexplib and bin_prot: based on Tywith, by Martin
+  Sandin.  License can be found in base/sexplib/LICENSE-Tywith.txt,
+  base/type_conv/LICENSE-Tywith.txt, and base/bin_prot/LICENSE-Tywith.txt.
+
+- Core's implementation of union-find: based on an implementation by
+  Henry Matthew Fluet, Suresh Jagannathan, and Stephen Weeks. License
+  can be found in base/core/MLton-license.
+
+- Various Core libraries are based on INRIA's OCaml
+  distribution. Relicensed under Apache 2.0, as permitted under the
+  Caml License for Consortium members:
+
+     http://caml.inria.fr/consortium/license.en.html
+
+  See also the disclaimer INRIA-DISCLAIMER.txt.

_oasis

@@ -0,0 +1,33 @@
+OASISFormat:      0.4
+OCamlVersion:     >= 4.02.3
+FindlibVersion:   >= 1.3.2
+Name:             ppx_let
+Version:          113.24.00
+Synopsis:         Monadic let-bindings
+Authors:          Jane Street Group, LLC <opensource@janestreet.com>
+Copyrights:       (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
+Maintainers:      Jane Street Group, LLC <opensource@janestreet.com>
+License:          Apache-2.0
+LicenseFile:      LICENSE.txt
+Homepage:         https://github.com/janestreet/ppx_let
+Plugins:          StdFiles (0.3), DevFiles (0.3), META (0.3)
+XStdFilesAUTHORS: false
+XStdFilesREADME:  false
+BuildTools:       ocamlbuild
+FilesAB:          META.ab
+Description:
+  Part of the Jane Street's PPX rewriters collection.
+
+Library ppx_let
+  Path:         src
+  Pack:         false
+  Modules:      Ppx_let
+  BuildDepends: ppx_core,
+                ppx_driver
+
+Executable ppx
+  Path:           as_ppx
+  MainIs:         ppx.ml
+  CompiledObject: best
+  BuildDepends:   ppx_let,
+                  ppx_driver

_tags

@@ -0,0 +1,8 @@
+<**/*.ml{,i}>: warn(-40), no_alias_deps
+<**/*>: thread
+# This prevents the implicit addition of -ppx options by ocamlfind
+<**/*.ml{,i}>: predicate(ppx_driver)
+<as_ppx/ppx.{byte,native}>: predicate(ppx_driver)
+<src/*>: linkall
+# OASIS_START
+# OASIS_STOP

as_ppx/ppx.ml

@@ -0,0 +1 @@
+Ppx_driver.run_as_ppx_rewriter ()

configure

@@ -0,0 +1,5 @@
+#!/bin/sh
+
+# OASIS_START
+make configure CONFIGUREFLAGS="$*"
+# OASIS_STOP

descr

@@ -0,0 +1,2 @@
+Monadic let-bindings
+Part of the Jane Street's PPX rewriters collection.

js-utils/gen_install.ml

@@ -0,0 +1,102 @@
+(* Generate <package>.install from setup.log *)
+
+#use "install_tags.ml"
+
+module String_map = Map.Make(String)
+let string_map_of_list =
+  List.fold_left
+    (fun acc (k, v) ->
+       assert (not (String_map.mem k acc));
+       String_map.add k v acc)
+    String_map.empty
+
+let lines_of_file fn =
+  let ic = open_in fn in
+  let rec loop acc =
+    match input_line ic with
+    | exception End_of_file ->
+      close_in ic;
+      List.rev acc
+    | line ->
+      loop (line :: acc)
+  in
+  loop []
+
+let read_setup_log () =
+  lines_of_file "setup.log"
+  |> List.map (fun line -> Scanf.sscanf line "%S %S" (fun tag arg -> (tag, arg)))
+
+let read_setup_data () =
+  lines_of_file "setup.data"
+  |> List.map (fun line -> Scanf.sscanf line "%[^=]=%S" (fun k v -> (k, v)))
+
+let remove_cwd =
+  let prefix = Sys.getcwd () ^ "/" in
+  let len_prefix = String.length prefix in
+  fun fn ->
+    let len = String.length fn in
+    if len >= len_prefix && String.sub fn 0 len_prefix = prefix then
+      String.sub fn len_prefix (len - len_prefix)
+    else
+      fn
+
+let gen_section oc name files =
+  let pr fmt = Printf.fprintf oc (fmt ^^ "\n") in
+  pr "%s: [" name;
+  List.iter
+    (fun (src, dst) ->
+       let src = remove_cwd src in
+       let dst =
+         match dst with
+         | None -> Filename.basename src
+         | Some fn -> fn
+       in
+       if src = dst then
+         pr "  %S" src
+       else
+         pr "  %S {%S}" src dst)
+    files;
+  pr "]"
+
+let rec filter_log tags log acc =
+  match log with
+  | [] -> acc
+  | (tag, fname) :: rest ->
+    match String_map.find tag tags with
+    | exception Not_found -> filter_log tags rest acc
+    | dst -> filter_log tags rest ((fname, dst) :: acc)
+
+let () =
+  let log = read_setup_log () in
+  let setup_data = read_setup_data () in
+  let ext_dll =
+    match List.assoc "ext_dll" setup_data with
+    | ext -> ext
+    | exception Not_found -> ".so"
+  in
+  let merge name files map =
+    match String_map.find name map with
+    | files' -> String_map.add name (files @ files') map
+    | exception Not_found -> String_map.add name files map
+  in
+  let sections =
+    List.fold_left
+      (fun acc (name, tags, extra_files) ->
+         let tags = string_map_of_list tags in
+         let files = filter_log tags log [] @ extra_files in
+         if name = "lib" then
+           let stubs, others =
+             List.partition
+               (fun (fn, _) -> Filename.check_suffix fn ext_dll)
+               files
+           in
+           merge "lib" others (merge "stublibs" stubs acc)
+         else
+           merge name files acc)
+      String_map.empty sections
+    |> String_map.bindings
+    |> List.filter (fun (_, l) -> l <> [])
+  in
+  let oc = open_out (package_name ^ ".install") in
+  List.iter (fun (name, files) -> gen_section oc name files) sections;
+  close_out oc

js-utils/install_tags.ml

@@ -0,0 +1,13 @@
+let package_name = "ppx_let"
+
+let sections =
+  [ ("lib",
+    [ ("built_lib_ppx_let", None)
+    ],
+    [ ("META", None)
+    ])
+  ; ("libexec",
+    [ ("built_exec_ppx", Some "ppx")
+    ],
+    [])
+  ]

myocamlbuild.ml

@@ -0,0 +1,29 @@
+(* OASIS_START *)
+(* OASIS_STOP *)
+# 3 "myocamlbuild.ml"
+
+(* Temporary hacks *)
+let js_hacks = function
+  | After_rules ->
+    rule "Generate a cmxs from a cmxa"
+      ~dep:"%.cmxa"
+      ~prod:"%.cmxs"
+      ~insert:`top
+      (fun env _ ->
+         Cmd (S [ !Options.ocamlopt
+                ; A "-shared"
+                ; A "-linkall"
+                ; A "-I"; A (Pathname.dirname (env "%"))
+                ; A (env "%.cmxa")
+                ; A "-o"
+                ; A (env "%.cmxs")
+            ]));
+
+    (* Pass -predicates to ocamldep *)
+    pflag ["ocaml"; "ocamldep"] "predicate" (fun s -> S [A "-predicates"; A s])
+  | _ -> ()
+
+let () =
+  Ocamlbuild_plugin.dispatch (fun hook ->
+    js_hacks hook;
+    dispatch_default hook)

opam

@@ -0,0 +1,19 @@
+opam-version: "1.2"
+maintainer: "opensource@janestreet.com"
+authors: ["Jane Street Group, LLC <opensource@janestreet.com>"]
+homepage: "https://github.com/janestreet/ppx_let"
+bug-reports: "https://github.com/janestreet/ppx_let/issues"
+dev-repo: "https://github.com/janestreet/ppx_let.git"
+license: "Apache-2.0"
+build: [
+  ["./configure" "--prefix" prefix]
+  [make]
+]
+depends: [
+  "ocamlbuild" {build}
+  "oasis"      {build & >= "0.4"}
+  "ocamlfind"  {build & >= "1.3.2"}
+  "ppx_core"
+  "ppx_driver"
+]
+available: [ ocaml-version >= "4.02.3" ]

setup.ml

@@ -0,0 +1,6 @@
+(* OASIS_START *)
+open OASISDynRun;;
+open OASISTypes;;
+(* OASIS_STOP *)
+
+let () = setup ()

src/ppx_let.ml

@@ -0,0 +1,149 @@
+open! StdLabels
+open Ppx_core.Std
+open Parsetree
+open Ast_builder.Default
+
+module List = struct
+  include List
+
+  let reduce_exn l ~f =
+    match l with
+    | [] -> invalid_arg "List.reduce_exn"
+    | hd :: tl -> fold_left tl ~init:hd ~f
+end
+
+module Extension_name = struct
+  type t =
+    | Bind
+    | Bind_open
+    | Map
+    | Map_open
+
+  let operator_name = function
+    | Bind | Bind_open -> "bind"
+    | Map  | Map_open  -> "map"
+
+  let to_string =  function
+    | Bind      -> "bind"
+    | Bind_open -> "bind_open"
+    | Map       -> "map"
+    | Map_open  -> "map_open"
+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
+  pexp_ident ~loc (Located.mk ~loc lid)
+;;
+
+let expand_with_tmp_vars ~loc bindings expr ~f =
+  match bindings with
+  | [_] -> f ~loc bindings expr
+  | _ ->
+    let tmp_vars = List.map bindings ~f:(fun _ -> gen_symbol ~prefix:"__let_syntax" ()) in
+    let s_rhs_tmp_var (* s/rhs/tmp_var *) =
+      List.map2 bindings tmp_vars ~f:(fun vb var ->
+        { vb with pvb_expr = evar ~loc:vb.pvb_expr.pexp_loc var })
+    in
+    let s_lhs_tmp_var (* s/lhs/tmp_var *) =
+      List.map2 bindings tmp_vars  ~f:(fun vb var ->
+        { vb with pvb_pat = pvar ~loc:vb.pvb_pat.ppat_loc var })
+    in
+    pexp_let ~loc Nonrecursive s_lhs_tmp_var (f ~loc s_rhs_tmp_var expr)
+;;
+
+let bind_apply ~loc extension_name ~arg ~fn =
+  let fn_label =
+    match (extension_name : Extension_name.t) with
+    | Bind | Bind_open -> ""
+    | Map  | Map_open  -> "f"
+  in
+  pexp_apply ~loc
+    (eoperator ~loc (Extension_name.operator_name extension_name))
+    [("", arg); (fn_label, fn)]
+;;
+
+let maybe_open extension_name ~loc ~to_open:module_to_open expr =
+  match (extension_name : Extension_name.t) with
+  | Bind      | Map      -> expr
+  | Bind_open | Map_open -> pexp_open ~loc Override (module_to_open ~loc) expr
+;;
+
+let expand_let extension_name ~loc bindings body =
+  (* Build expression [both E1 (both E2 (both ...))] *)
+  let nested_boths =
+    let rev_boths = List.rev_map bindings ~f:(fun vb -> vb.pvb_expr) in
+    List.reduce_exn rev_boths ~f:(fun acc e ->
+      let loc = e.pexp_loc in
+      eapply ~loc (eoperator ~loc "both") [e; acc])
+  in
+  (* Build pattern [(P1, (P2, ...))] *)
+  let nested_patterns =
+    let rev_patts = List.rev_map bindings ~f:(fun vb -> vb.pvb_pat) in
+    List.reduce_exn rev_patts ~f:(fun acc p ->
+      let loc = p.ppat_loc in
+      ppat_tuple ~loc [p; acc])
+  in
+  bind_apply ~loc extension_name ~arg:nested_boths
+    ~fn:(pexp_fun ~loc "" None nested_patterns
+           (maybe_open extension_name ~loc ~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 ~loc ~to_open:open_in_body case.pc_rhs;
+      })
+  in
+  bind_apply ~loc extension_name
+    ~arg:(maybe_open extension_name ~loc ~to_open:open_on_rhs expr)
+    ~fn:(pexp_function ~loc cases)
+;;
+
+let expand ~loc:_ ~path:_ extension_name expr =
+  let loc = expr.pexp_loc in
+  let expansion =
+    match expr.pexp_desc with
+    | Pexp_let (Nonrecursive, bindings, expr) ->
+      let bindings =
+        List.map bindings ~f:(fun vb ->
+          { vb with
+            pvb_expr = maybe_open extension_name ~loc ~to_open:open_on_rhs vb.pvb_expr;
+          })
+      in
+      expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name)
+    | Pexp_let (Recursive, _, _) ->
+      Location.raise_errorf ~loc "'let%%%s' may not be recursive"
+        (Extension_name.to_string extension_name)
+    | Pexp_match (expr, cases) ->
+      expand_match extension_name ~loc expr cases
+    | _ ->
+      Location.raise_errorf ~loc
+        "'%%%s' can only be used with 'let' and 'match'"
+        (Extension_name.to_string extension_name)
+  in
+  { expansion with pexp_attributes = expr.pexp_attributes @ expansion.pexp_attributes }
+;;
+
+let ext extension_name =
+  Extension.V2.declare
+    (Extension_name.to_string extension_name)
+    Extension.Context.expression
+    Ast_pattern.(single_expr_payload __)
+    (expand extension_name)
+;;
+
+let () =
+  Ppx_driver.register_transformation "let"
+    ~extensions:[
+      ext Bind;
+      ext Bind_open;
+      ext Map;
+      ext Map_open;
+    ]
+;;

src/ppx_let.mli

@@ -0,0 +1 @@
+(* This signature is deliberately empty. *)

test/test.ml

@@ -0,0 +1,229 @@
+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
+      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 = struct
+    type 'a t = 'a
+    let return x = x
+    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
+
+  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
+      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 = 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
+      include Param
+      module Open_on_rhs = Param
+      module Open_in_body = struct end
+    end
+  end
+
+  module Command_override = struct
+    module Param = struct
+      include Command.Param
+      let special_flag = flag 88
+    end
+    module Let_syntax = struct
+      include (Command.Let_syntax : module type of Command.Let_syntax
+               with module Open_on_rhs  := Command.Let_syntax.Open_on_rhs
+                and module Open_in_body := Command.Let_syntax.Open_in_body)
+
+      module Open_on_rhs = Param
+      module Open_in_body = struct
+        module Let_syntax = Deferred.Let_syntax
+      end
+    end
+  end
+
+  let _1 : int Command.Param.t =
+    let module Let_syntax = 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 module Let_syntax = 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 module Let_syntax = Command_override.Let_syntax in
+    [%map_open
+      let () = return () in
+      fun () ->
+        let%map () = Deferred.return () in
+        ()
+    ]
+  ;;
+end