From f255c375a06ab1581ec70420963efd34ae89ea50 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 12 Jan 2016 17:20:06 +0000 Subject: [PATCH 01/59] 113.24.00 --- .gitignore | 7 ++ INRIA-DISCLAIMER.txt | 12 ++ LICENSE.txt | 202 ++++++++++++++++++++++++++++++++++ META.ab | 8 ++ Makefile | 68 ++++++++++++ README.md | 156 ++++++++++++++++++++++++++ THIRD-PARTY.txt | 18 +++ _oasis | 33 ++++++ _tags | 8 ++ as_ppx/ppx.ml | 1 + configure | 5 + descr | 2 + js-utils/gen_install.ml | 102 +++++++++++++++++ js-utils/install_tags.ml | 13 +++ myocamlbuild.ml | 29 +++++ opam | 19 ++++ setup.ml | 6 + src/ppx_let.ml | 149 +++++++++++++++++++++++++ src/ppx_let.mli | 1 + test/test.ml | 229 +++++++++++++++++++++++++++++++++++++++ 20 files changed, 1068 insertions(+) create mode 100644 .gitignore create mode 100644 INRIA-DISCLAIMER.txt create mode 100644 LICENSE.txt create mode 100644 META.ab create mode 100644 Makefile create mode 100644 README.md create mode 100644 THIRD-PARTY.txt create mode 100644 _oasis create mode 100644 _tags create mode 100644 as_ppx/ppx.ml create mode 100755 configure create mode 100644 descr create mode 100644 js-utils/gen_install.ml create mode 100644 js-utils/install_tags.ml create mode 100644 myocamlbuild.ml create mode 100644 opam create mode 100644 setup.ml create mode 100644 src/ppx_let.ml create mode 100644 src/ppx_let.mli create mode 100644 test/test.ml diff --git a/.gitignore b/.gitignore new file mode 100644 index 000000000..8dac9f323 --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +_build/ +/setup.data +/setup.log +/*.exe +/*.docdir +/*.native +/*.byte diff --git a/INRIA-DISCLAIMER.txt b/INRIA-DISCLAIMER.txt new file mode 100644 index 000000000..01d2976d7 --- /dev/null +++ b/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. + diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 000000000..d64569567 --- /dev/null +++ b/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. diff --git a/META.ab b/META.ab new file mode 100644 index 000000000..8dc31d222 --- /dev/null +++ b/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" diff --git a/Makefile b/Makefile new file mode 100644 index 000000000..d97d2e123 --- /dev/null +++ b/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 diff --git a/README.md b/README.md new file mode 100644 index 000000000..cbd8c2ede --- /dev/null +++ b/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. diff --git a/THIRD-PARTY.txt b/THIRD-PARTY.txt new file mode 100644 index 000000000..da8a77285 --- /dev/null +++ b/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. diff --git a/_oasis b/_oasis new file mode 100644 index 000000000..98075ac8e --- /dev/null +++ b/_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 +Copyrights: (C) 2015-2016 Jane Street Group LLC +Maintainers: Jane Street Group, LLC +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 diff --git a/_tags b/_tags new file mode 100644 index 000000000..48f85ad4b --- /dev/null +++ b/_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) +: predicate(ppx_driver) +: linkall +# OASIS_START +# OASIS_STOP diff --git a/as_ppx/ppx.ml b/as_ppx/ppx.ml new file mode 100644 index 000000000..e0c207cce --- /dev/null +++ b/as_ppx/ppx.ml @@ -0,0 +1 @@ +Ppx_driver.run_as_ppx_rewriter () diff --git a/configure b/configure new file mode 100755 index 000000000..3234be22e --- /dev/null +++ b/configure @@ -0,0 +1,5 @@ +#!/bin/sh + +# OASIS_START +make configure CONFIGUREFLAGS="$*" +# OASIS_STOP diff --git a/descr b/descr new file mode 100644 index 000000000..fad50b245 --- /dev/null +++ b/descr @@ -0,0 +1,2 @@ +Monadic let-bindings +Part of the Jane Street's PPX rewriters collection. diff --git a/js-utils/gen_install.ml b/js-utils/gen_install.ml new file mode 100644 index 000000000..39db64239 --- /dev/null +++ b/js-utils/gen_install.ml @@ -0,0 +1,102 @@ +(* Generate .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 diff --git a/js-utils/install_tags.ml b/js-utils/install_tags.ml new file mode 100644 index 000000000..c0c42dc6e --- /dev/null +++ b/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") + ], + []) + ] diff --git a/myocamlbuild.ml b/myocamlbuild.ml new file mode 100644 index 000000000..46889547f --- /dev/null +++ b/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) diff --git a/opam b/opam new file mode 100644 index 000000000..ce1c4a254 --- /dev/null +++ b/opam @@ -0,0 +1,19 @@ +opam-version: "1.2" +maintainer: "opensource@janestreet.com" +authors: ["Jane Street Group, LLC "] +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" ] diff --git a/setup.ml b/setup.ml new file mode 100644 index 000000000..f6b6bc3b8 --- /dev/null +++ b/setup.ml @@ -0,0 +1,6 @@ +(* OASIS_START *) +open OASISDynRun;; +open OASISTypes;; +(* OASIS_STOP *) + +let () = setup () diff --git a/src/ppx_let.ml b/src/ppx_let.ml new file mode 100644 index 000000000..fa7a986e7 --- /dev/null +++ b/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; + ] +;; diff --git a/src/ppx_let.mli b/src/ppx_let.mli new file mode 100644 index 000000000..34976fd80 --- /dev/null +++ b/src/ppx_let.mli @@ -0,0 +1 @@ +(* This signature is deliberately empty. *) diff --git a/test/test.ml b/test/test.ml new file mode 100644 index 000000000..724543ce8 --- /dev/null +++ b/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 From 4f498086fa76e32ddc35ecfd958d5f78b9a64e8d Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Wed, 9 Mar 2016 15:44:54 +0000 Subject: [PATCH 02/59] 113.33.00 --- _oasis | 2 +- js-utils/install_tags.ml | 4 +-- src/ppx_let.ml | 11 ++++--- test/test-locations.mlt | 19 +++++++++++ test/test.ml | 71 ++++++++++++++++++++++------------------ 5 files changed, 68 insertions(+), 39 deletions(-) create mode 100644 test/test-locations.mlt diff --git a/_oasis b/_oasis index 98075ac8e..0e8538ec4 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.02.3 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 113.24.00 +Version: 113.33.00 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/js-utils/install_tags.ml b/js-utils/install_tags.ml index c0c42dc6e..6f8f3879c 100644 --- a/js-utils/install_tags.ml +++ b/js-utils/install_tags.ml @@ -6,8 +6,8 @@ let sections = ], [ ("META", None) ]) - ; ("libexec", - [ ("built_exec_ppx", Some "ppx") + ; ("bin", + [ ("built_exec_ppx", Some "../lib/ppx_let/ppx") ], []) ] diff --git a/src/ppx_let.ml b/src/ppx_let.ml index fa7a986e7..17e3a2777 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -67,7 +67,8 @@ let bind_apply ~loc extension_name ~arg ~fn = [("", arg); (fn_label, fn)] ;; -let maybe_open extension_name ~loc ~to_open:module_to_open expr = +let maybe_open extension_name ~to_open:module_to_open expr = + let loc = expr.pexp_loc in match (extension_name : Extension_name.t) with | Bind | Map -> expr | Bind_open | Map_open -> pexp_open ~loc Override (module_to_open ~loc) expr @@ -90,18 +91,18 @@ let expand_let extension_name ~loc bindings body = 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)) + (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 ~loc ~to_open:open_in_body case.pc_rhs; + 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 ~loc ~to_open:open_on_rhs expr) + ~arg:(maybe_open extension_name ~to_open:open_on_rhs expr) ~fn:(pexp_function ~loc cases) ;; @@ -113,7 +114,7 @@ let expand ~loc:_ ~path:_ extension_name 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; + pvb_expr = maybe_open extension_name ~to_open:open_on_rhs vb.pvb_expr; }) in expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name) diff --git a/test/test-locations.mlt b/test/test-locations.mlt new file mode 100644 index 000000000..402dbc4e1 --- /dev/null +++ b/test/test-locations.mlt @@ -0,0 +1,19 @@ +(* -*- tuareg -*- *) + +module Let_syntax = struct + type 'a t = T of 'a + let map (T x) ~f = T (f x) + let both (T x) (T y) = T (x, y) + module Open_on_rhs = 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 ()] +[%%expect{| +Line _, characters 45-49: +Error: This expression has type doc:bytes -> (int * bytes) Let_syntax.t + but an expression was expected of type 'a Let_syntax.t +|}] diff --git a/test/test.ml b/test/test.ml index 724543ce8..420b25b73 100644 --- a/test/test.ml +++ b/test/test.ml @@ -127,22 +127,26 @@ module Async_command_override_example = struct 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 + 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 - 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 + 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 @@ -154,13 +158,15 @@ module Async_command_override_example = struct 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 + 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 @@ -171,9 +177,11 @@ module Async_command_override_example = struct let anon _ = 77 end module Let_syntax = struct - include Param - module Open_on_rhs = Param - module Open_in_body = struct end + module Let_syntax = struct + include Param + module Open_on_rhs = Param + module Open_in_body = struct end + end end end @@ -183,19 +191,20 @@ module Async_command_override_example = struct 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) + 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 = struct - module Let_syntax = Deferred.Let_syntax + module Open_on_rhs = Param + module Open_in_body = Deferred.Let_syntax end end end let _1 : int Command.Param.t = - let module Let_syntax = Command.Let_syntax in + let open Command.Let_syntax in [%map_open let x = flag "foo" and y = anon "bar" @@ -205,7 +214,7 @@ module Async_command_override_example = struct ;; let _1 : (unit -> int Deferred.t) Command_override.Param.t = - let module Let_syntax = Command_override.Let_syntax in + let open Command_override.Let_syntax in [%map_open let x = flag "foo" and y = anon "bar" @@ -218,7 +227,7 @@ module Async_command_override_example = struct ;; let _1 : (unit -> unit Deferred.t) Command.Param.t = - let module Let_syntax = Command_override.Let_syntax in + let open Command_override.Let_syntax in [%map_open let () = return () in fun () -> From d3a4211d6aeeed610fbe1e291fa96ec7c6b8c6ba Mon Sep 17 00:00:00 2001 From: Ashish Agarwal Date: Wed, 6 Apr 2016 17:26:23 -0400 Subject: [PATCH 03/59] README.md: fix project name --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index cbd8c2ede..2637156fc 100644 --- a/README.md +++ b/README.md @@ -31,7 +31,7 @@ getting the right names into scope). ### Parallel bindings -ppx\_monad understands parallel bindings as well. i.e.: +ppx\_let understands parallel bindings as well. i.e.: ```ocaml let%bind VAR1 = EXPR1 and VAR2 = EXPR2 and VAR3 = EXPR3 in BODY @@ -48,7 +48,7 @@ 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 +well. So for convenience ppx\_let 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`. @@ -104,7 +104,7 @@ map (fun (P1, (P2, (P3, P4))) -> E) ``` -respectively. (Instead of `x1`, `x2`, ... ppx\_monad uses +respectively. (Instead of `x1`, `x2`, ... ppx\_let uses variable names that are unlikely to clash with other names) As with `let`, names introduced by left-hand sides of the let bindings From 5b78706d342fec381ac3b0695180541b6a1c4fd1 Mon Sep 17 00:00:00 2001 From: Ashish Agarwal Date: Wed, 6 Apr 2016 17:27:28 -0400 Subject: [PATCH 04/59] README.md: minor grammar fix --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 2637156fc..7e50b0323 100644 --- a/README.md +++ b/README.md @@ -48,7 +48,7 @@ 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\_let also accept `%bind` and `%map` on +well. So for convenience ppx\_let also accepts `%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`. From ba530c73b96861fb8f9b3b7b9e7bda98212aa9ce Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 26 Apr 2016 17:03:48 +0100 Subject: [PATCH 05/59] 113.33.03 --- META.ab | 9 ++-- Makefile | 4 +- _oasis | 37 +++++++------- _tags | 2 +- install.ml | 10 ++++ js-utils/gen_install.ml | 102 --------------------------------------- js-utils/install_tags.ml | 13 ----- myocamlbuild.ml | 25 ++-------- opam | 7 +-- 9 files changed, 47 insertions(+), 162 deletions(-) create mode 100644 install.ml delete mode 100644 js-utils/gen_install.ml delete mode 100644 js-utils/install_tags.ml diff --git a/META.ab b/META.ab index 8dc31d222..1597907eb 100644 --- a/META.ab +++ b/META.ab @@ -1,8 +1,9 @@ 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" +archive(ppx_driver, byte ) = "ppx_let.cma" +archive(ppx_driver, native) = "ppx_let.cmxa" +plugin(ppx_driver, byte ) = "ppx_let.cma" +plugin(ppx_driver, native) = "ppx_let.cmxs" exists_if = "ppx_let.cma" -ppx(-ppx_driver) = "./ppx" +ppx(-ppx_driver,-custom_ppx) = "./ppx" diff --git a/Makefile b/Makefile index d97d2e123..07639e816 100644 --- a/Makefile +++ b/Makefile @@ -26,8 +26,8 @@ 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 +$(NAME).install: install.ml setup.log setup.data + ocaml install.ml install: $(NAME).install opam-installer -i --prefix $(PREFIX) $(NAME).install diff --git a/_oasis b/_oasis index 0e8538ec4..0ce6f20d9 100644 --- a/_oasis +++ b/_oasis @@ -1,20 +1,23 @@ -OASISFormat: 0.4 -OCamlVersion: >= 4.02.3 -FindlibVersion: >= 1.3.2 -Name: ppx_let -Version: 113.33.00 -Synopsis: Monadic let-bindings -Authors: Jane Street Group, LLC -Copyrights: (C) 2015-2016 Jane Street Group LLC -Maintainers: Jane Street Group, LLC -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 +OASISFormat: 0.4 +OCamlVersion: >= 4.02.3 +FindlibVersion: >= 1.3.2 +Name: ppx_let +Version: 113.33.03 +Synopsis: Monadic let-bindings +Authors: Jane Street Group, LLC +Copyrights: (C) 2015-2016 Jane Street Group LLC +Maintainers: Jane Street Group, LLC +License: Apache-2.0 +LicenseFile: LICENSE.txt +Homepage: https://github.com/janestreet/ppx_let +Plugins: StdFiles (0.3), DevFiles (0.3) +XStdFilesAUTHORS: false +XStdFilesREADME: false +BuildTools: ocamlbuild +BetaFeatures: section_object +AlphaFeatures: ocamlbuild_more_args +XOCamlbuildPluginTags: package(js-build-tools.ocamlbuild_goodies) +FilesAB: META.ab Description: Part of the Jane Street's PPX rewriters collection. diff --git a/_tags b/_tags index 48f85ad4b..eed4cdef9 100644 --- a/_tags +++ b/_tags @@ -1,7 +1,7 @@ <**/*.ml{,i}>: warn(-40), no_alias_deps <**/*>: thread # This prevents the implicit addition of -ppx options by ocamlfind -<**/*.ml{,i}>: predicate(ppx_driver) +<**/*>: predicate(custom_ppx) : predicate(ppx_driver) : linkall # OASIS_START diff --git a/install.ml b/install.ml new file mode 100644 index 000000000..86d1afc2b --- /dev/null +++ b/install.ml @@ -0,0 +1,10 @@ +#use "topfind";; +#require "js-build-tools.oasis2opam_install";; + +open Oasis2opam_install;; + +generate ~package:"ppx_let" + [ oasis_lib "ppx_let" + ; file "META" ~section:"lib" + ; oasis_exe "ppx" ~dest:"../lib/ppx_let/ppx" + ] diff --git a/js-utils/gen_install.ml b/js-utils/gen_install.ml deleted file mode 100644 index 39db64239..000000000 --- a/js-utils/gen_install.ml +++ /dev/null @@ -1,102 +0,0 @@ -(* Generate .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 diff --git a/js-utils/install_tags.ml b/js-utils/install_tags.ml deleted file mode 100644 index 6f8f3879c..000000000 --- a/js-utils/install_tags.ml +++ /dev/null @@ -1,13 +0,0 @@ -let package_name = "ppx_let" - -let sections = - [ ("lib", - [ ("built_lib_ppx_let", None) - ], - [ ("META", None) - ]) - ; ("bin", - [ ("built_exec_ppx", Some "../lib/ppx_let/ppx") - ], - []) - ] diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 46889547f..326d29383 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -2,28 +2,13 @@ (* 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") - ])); +module JS = Jane_street_ocamlbuild_goodies - (* Pass -predicates to ocamldep *) - pflag ["ocaml"; "ocamldep"] "predicate" (fun s -> S [A "-predicates"; A s]) - | _ -> () +let dev_mode = true let () = Ocamlbuild_plugin.dispatch (fun hook -> - js_hacks hook; + JS.alt_cmxs_of_cmxa_rule hook; + JS.pass_predicates_to_ocamldep hook; + if dev_mode && not Sys.win32 then JS.track_external_deps hook; dispatch_default hook) diff --git a/opam b/opam index ce1c4a254..3e8ed8000 100644 --- a/opam +++ b/opam @@ -10,9 +10,10 @@ build: [ [make] ] depends: [ - "ocamlbuild" {build} - "oasis" {build & >= "0.4"} - "ocamlfind" {build & >= "1.3.2"} + "ocamlbuild" {build} + "oasis" {build & >= "0.4"} + "ocamlfind" {build & >= "1.3.2"} + "js-build-tools" {build} "ppx_core" "ppx_driver" ] From 539de799a18df6a4d2ce90245252aa3729d86427 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 27 Apr 2016 14:42:50 +0100 Subject: [PATCH 06/59] fix call to `ocaml install.ml` in Makefile --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 07639e816..28998046d 100644 --- a/Makefile +++ b/Makefile @@ -27,7 +27,7 @@ all: $(SETUP) $(MAKE) $(NAME).install $(NAME).install: install.ml setup.log setup.data - ocaml install.ml + ocaml -I "$(OCAML_TOPLEVEL_PATH)" install.ml install: $(NAME).install opam-installer -i --prefix $(PREFIX) $(NAME).install From 505f76ad99e3d66523bf1332cbe5da88b91b50ae Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 28 Apr 2016 10:46:24 +0100 Subject: [PATCH 07/59] fix constraint in opam file --- opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/opam b/opam index 3e8ed8000..e32b9a873 100644 --- a/opam +++ b/opam @@ -17,4 +17,4 @@ depends: [ "ppx_core" "ppx_driver" ] -available: [ ocaml-version >= "4.02.3" ] +available: [ ocaml-version = "4.02.3" ] From e3c12d9dd2179b65ccf5f9e4e8a7ebb91ca3cf6f Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 20 May 2016 12:01:06 +0100 Subject: [PATCH 08/59] 113.43+70 --- META.ab | 2 +- Makefile | 2 +- README.md | 21 ++--- _oasis | 5 +- src/ppx_let.ml | 12 +-- test/test-locations.mlt | 1 - test/test.ml | 172 ++++++++-------------------------------- 7 files changed, 46 insertions(+), 169 deletions(-) diff --git a/META.ab b/META.ab index 1597907eb..6b930b3f2 100644 --- a/META.ab +++ b/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" diff --git a/Makefile b/Makefile index 28998046d..8b90c0267 100644 --- a/Makefile +++ b/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 diff --git a/README.md b/README.md index 7e50b0323..de43bbc63 100644 --- a/README.md +++ b/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 -of `%map` and `%bind` called `%map_open` and `%bind_open`. +The `Open_on_rhs` submodule is used by variants of `%map` and `%bind` +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 -of the rewritten let bindings in `%map_open` and `%bind_open` -expressions. This is useful when programming with applicatives, which +`Open_on_rhs` 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. diff --git a/_oasis b/_oasis index 0ce6f20d9..eb863eaa6 100644 --- a/_oasis +++ b/_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 Copyrights: (C) 2015-2016 Jane Street Group LLC @@ -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 diff --git a/src/ppx_let.ml b/src/ppx_let.ml index 17e3a2777..b3079c11d 100644 --- a/src/ppx_let.ml +++ b/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 - (maybe_open extension_name ~to_open:open_in_body body)) + ~fn:(pexp_fun ~loc "" None nested_patterns 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 __) diff --git a/test/test-locations.mlt b/test/test-locations.mlt index 402dbc4e1..79027c87f 100644 --- a/test/test-locations.mlt +++ b/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 ()] diff --git a/test/test.ml b/test/test.ml index 420b25b73..0dc4960fe 100644 --- a/test/test.ml +++ b/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 - 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 + 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 + 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 - let map = map - let both = both - module Open_on_rhs = struct let return = return end - module Open_in_body = struct let return = return end + 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 - 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 - val both : 'a t -> 'b t -> ('a * 'b) t - module Open_on_rhs : sig - val flag : int t - val anon : int 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 - 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 - let both = both - module Open_on_rhs = struct - let flag = 66 - let anon = 77 + 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 - 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 From d0825b3b1914f26f08645b1e612f2d9b2c822758 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 20 May 2016 16:22:23 +0100 Subject: [PATCH 09/59] 113.43+70 --- CHANGES.md | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 CHANGES.md diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 index 000000000..03abc5dce --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,8 @@ +## 113.43.00 + +- Dropped `Open_in_body` support from ppx\_let, since it was only ever used + in confusing chains of `Let_syntax` modules that introduced other + `Let_syntax` modules in the "body" (e.g. for defining Commands whose + bodies use Async). In this case it was decided that the better + practice is to be explicit with `open ___.Let_syntax` at the different + transition points, even though this is more verbose. From ea17c43e1c920af7bf5685ba316d804b9e7aac14 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 12 Jul 2016 17:08:10 +0100 Subject: [PATCH 10/59] 114.01+04 --- _oasis | 2 +- src/ppx_let.ml | 4 ++-- test/test-locations.mlt | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/_oasis b/_oasis index eb863eaa6..0b3a23769 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.02.3 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 113.43+70 +Version: 114.01+04 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/src/ppx_let.ml b/src/ppx_let.ml index b3079c11d..ce38f4e08 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -63,7 +63,7 @@ let bind_apply ~loc extension_name ~arg ~fn = in pexp_apply ~loc (eoperator ~loc (Extension_name.operator_name extension_name)) - [("", arg); (fn_label, fn)] + [(Nolabel, arg); (Labelled fn_label, fn)] ;; let maybe_open extension_name ~to_open:module_to_open expr = @@ -89,7 +89,7 @@ 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 body) + ~fn:(pexp_fun ~loc Nolabel None nested_patterns body) ;; let expand_match extension_name ~loc expr cases = diff --git a/test/test-locations.mlt b/test/test-locations.mlt index 79027c87f..765b8b345 100644 --- a/test/test-locations.mlt +++ b/test/test-locations.mlt @@ -13,6 +13,6 @@ end let _ = [%map_open let x = return 42 and y = f 42 in ()] [%%expect{| Line _, characters 45-49: -Error: This expression has type doc:bytes -> (int * bytes) Let_syntax.t +Error: This expression has type doc:string -> (int * string) Let_syntax.t but an expression was expected of type 'a Let_syntax.t |}] From 4cf0ca0fb88634d1c483198aea7ea2d3cf1645a9 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 19 Jul 2016 08:54:08 +0100 Subject: [PATCH 11/59] 114.02+05 --- _oasis | 4 ++-- opam | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/_oasis b/_oasis index 0b3a23769..70077b89a 100644 --- a/_oasis +++ b/_oasis @@ -1,8 +1,8 @@ OASISFormat: 0.4 -OCamlVersion: >= 4.02.3 +OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.01+04 +Version: 114.02+05 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/opam b/opam index e32b9a873..48c0967d0 100644 --- a/opam +++ b/opam @@ -17,4 +17,4 @@ depends: [ "ppx_core" "ppx_driver" ] -available: [ ocaml-version = "4.02.3" ] +available: [ ocaml-version = "4.03.0" ] From 5b5b67ce65ccaf371e1c47cf449c2f31d9af22e7 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 28 Jul 2016 13:20:02 +0100 Subject: [PATCH 12/59] 114.03+54 --- _oasis | 2 +- opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/_oasis b/_oasis index 70077b89a..249d3059d 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.02+05 +Version: 114.03+54 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/opam b/opam index 48c0967d0..5bc645771 100644 --- a/opam +++ b/opam @@ -17,4 +17,4 @@ depends: [ "ppx_core" "ppx_driver" ] -available: [ ocaml-version = "4.03.0" ] +available: [ ocaml-version >= "4.03.0" ] From ee1c44b56ec3668ecfc610cc4eff910729f07b62 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 3 Aug 2016 18:29:31 +0100 Subject: [PATCH 13/59] 114.04+40 --- _oasis | 2 +- src/ppx_let.ml | 7 +------ test/test.ml | 4 ++-- 3 files changed, 4 insertions(+), 9 deletions(-) diff --git a/_oasis b/_oasis index 249d3059d..2f8bfc78b 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.03+54 +Version: 114.04+40 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/src/ppx_let.ml b/src/ppx_let.ml index ce38f4e08..7c5c3198c 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -56,14 +56,9 @@ let expand_with_tmp_vars ~loc bindings expr ~f = ;; 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)) - [(Nolabel, arg); (Labelled fn_label, fn)] + [(Nolabel, arg); (Labelled "f", fn)] ;; let maybe_open extension_name ~to_open:module_to_open expr = diff --git a/test/test.ml b/test/test.ml index 0dc4960fe..90de6a874 100644 --- a/test/test.ml +++ b/test/test.ml @@ -6,7 +6,7 @@ module Monad_example = struct val return : 'a -> 'a t module Let_syntax : sig val return : 'a -> 'a t - val bind : 'a t -> ('a -> 'b t) -> 'b 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 @@ -15,7 +15,7 @@ module Monad_example = struct end = struct type 'a t = 'a let return x = x - let bind x f = f x + let bind x ~f = f x let map x ~f = f x let both x y = (x, y) module Let_syntax = struct From 368191deb1b0eedcf7e883ad38ea58808a5ff2b2 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 5 Aug 2016 13:22:37 +0100 Subject: [PATCH 14/59] 114.04+57 --- _oasis | 2 +- src/jbuild | 7 +++++++ test/jbuild | 6 ++++++ 3 files changed, 14 insertions(+), 1 deletion(-) create mode 100644 src/jbuild create mode 100644 test/jbuild diff --git a/_oasis b/_oasis index 2f8bfc78b..f674e7e8d 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.04+40 +Version: 114.04+57 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/src/jbuild b/src/jbuild new file mode 100644 index 000000000..cacfa4fb0 --- /dev/null +++ b/src/jbuild @@ -0,0 +1,7 @@ +(library + ((name ppx_let) + (public_name ppx_let) + (public_release ((kind ppx_rewriter))) + (wrapped false) + (libraries (ocamlcommon ppx_core ppx_driver)) + (preprocess ((no_preprocessing All))))) diff --git a/test/jbuild b/test/jbuild new file mode 100644 index 000000000..94cb75834 --- /dev/null +++ b/test/jbuild @@ -0,0 +1,6 @@ +(executables + ((names (test)) + (preprocess (((pps (ppx_let)) All))))) + +(toplevel_expect_tests + ((libraries (ppx_let)))) From a705eefcd3028d8dd5f3adea40ea83b0875dcbdf Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 19 Aug 2016 10:40:41 +0100 Subject: [PATCH 15/59] 114.06+90 --- INRIA-DISCLAIMER.txt | 12 ------------ THIRD-PARTY.txt | 18 ------------------ _oasis | 2 +- 3 files changed, 1 insertion(+), 31 deletions(-) delete mode 100644 INRIA-DISCLAIMER.txt delete mode 100644 THIRD-PARTY.txt diff --git a/INRIA-DISCLAIMER.txt b/INRIA-DISCLAIMER.txt deleted file mode 100644 index 01d2976d7..000000000 --- a/INRIA-DISCLAIMER.txt +++ /dev/null @@ -1,12 +0,0 @@ -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. - diff --git a/THIRD-PARTY.txt b/THIRD-PARTY.txt deleted file mode 100644 index da8a77285..000000000 --- a/THIRD-PARTY.txt +++ /dev/null @@ -1,18 +0,0 @@ -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. diff --git a/_oasis b/_oasis index f674e7e8d..a8c4dee04 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.04+57 +Version: 114.06+90 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC From 2d59732ae3f8ab64e3d75bba26ebf4eff3cb655d Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 30 Aug 2016 10:41:18 +0100 Subject: [PATCH 16/59] 114.08+30 --- _oasis | 2 +- opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/_oasis b/_oasis index a8c4dee04..305d7f260 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.06+90 +Version: 114.08+30 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/opam b/opam index 5bc645771..11096c238 100644 --- a/opam +++ b/opam @@ -11,7 +11,7 @@ build: [ ] depends: [ "ocamlbuild" {build} - "oasis" {build & >= "0.4"} + "oasis" {build & >= "0.4" & < "0.4.7"} "ocamlfind" {build & >= "1.3.2"} "js-build-tools" {build} "ppx_core" From cfc2ac765b8df9d3c3b28e002b08d3482f2c41c5 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 31 Aug 2016 16:09:28 +0100 Subject: [PATCH 17/59] 114.08+63 --- README.md | 128 ++++++++++++++++++++++++++----------------------- _oasis | 2 +- opam | 3 +- src/ppx_let.ml | 17 ++++++- test/test.ml | 10 ++++ 5 files changed, 98 insertions(+), 62 deletions(-) diff --git a/README.md b/README.md index de43bbc63..39f824987 100644 --- a/README.md +++ b/README.md @@ -1,33 +1,32 @@ -A ppx rewriter for monadic and applicative let bindings and match statements. +A ppx rewriter for monadic and applicative let bindings, match expressions, and +if expressions. 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: +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 +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 +val map : 'a t -> f:('a -> 'b) -> 'b t +val bind : 'a t -> f:('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). +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 @@ -37,9 +36,9 @@ ppx\_let understands parallel bindings as well. i.e.: 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: +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 @@ -47,47 +46,61 @@ 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\_let also accepts `%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`. +We found that this form was quite useful for match statements as well. So for +convenience ppx\_let also accepts `%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`. + +### If statements + +As a further convenience, ppx\_let accepts `%bind` and `%map` on the `if` +keyword. The expression `if%bind expr1 then expr2 else expr3` is morally +equivalent to `let%bind p = expr1 in if p then expr2 else expr3`. Syntactic forms and actual rewriting ------------------------------------ -`ppx_let` adds four syntactic forms +`ppx_let` adds six syntactic forms ```ocaml let%bind P = M in E -let%map 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 | ... +match%map M with P1 -> E1 | P2 -> E2 | ... + +if%bind M then E1 else E2 + +if%map M then E1 else E2 ``` that expand into ```ocaml -bind M (fun P -> E) +bind M ~f:(fun P -> E) -map M (fun P -> E) +map M ~f:(fun P -> E) -bind M (function P1 -> E1 | P2 -> E2 | ...) +bind M ~f:(function P1 -> E1 | P2 -> E2 | ...) -map M (function P1 -> E1 | P2 -> E2 | ...) +map M ~f:(function P1 -> E1 | P2 -> E2 | ...) + +bind M ~f:(function true -> E1 | false -> E2) + +map M ~f:(function true -> E1 | false -> E2) ``` respectively. -As with `let`, `let%bind` and `let%map` also support multiple -*parallel* bindings via the `and` keyword: +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 +let%map P1 = M1 and P2 = M2 and P3 = M3 and P4 = M4 in E ``` that expand into @@ -96,35 +109,34 @@ that expand into 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) + ~f:(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) + ~f:(fun (P1, (P2, (P3, P4))) -> E) ``` -respectively. (Instead of `x1`, `x2`, ... ppx\_let uses -variable names that are unlikely to clash with other names) +respectively. (Instead of `x1`, `x2`, ... ppx\_let 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. +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`. +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 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 +For applicatives. The convention for these modules is to have a submodule +`Let_syntax` of the form ```ocaml module Let_syntax : sig @@ -135,15 +147,13 @@ module Let_syntax : sig end ``` -The `Open_on_rhs` submodule is used by variants of `%map` and `%bind` -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 used by variants of `%map` and `%bind` 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. -`Open_on_rhs` 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`. +`Open_on_rhs` 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`. diff --git a/_oasis b/_oasis index 305d7f260..ec4c940b6 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.08+30 +Version: 114.08+63 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/opam b/opam index 11096c238..b02f5c062 100644 --- a/opam +++ b/opam @@ -11,10 +11,11 @@ build: [ ] depends: [ "ocamlbuild" {build} - "oasis" {build & >= "0.4" & < "0.4.7"} + "oasis" {build & >= "0.4"} "ocamlfind" {build & >= "1.3.2"} "js-build-tools" {build} "ppx_core" "ppx_driver" ] available: [ ocaml-version >= "4.03.0" ] +conclicts: [ "oasis" {= "0.4.7"} ] diff --git a/src/ppx_let.ml b/src/ppx_let.ml index 7c5c3198c..21c8de750 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -93,6 +93,12 @@ let expand_match extension_name ~loc expr cases = ~fn:(pexp_function ~loc cases) ;; +let expand_if extension_name ~loc expr then_ else_ = + expand_match extension_name ~loc expr + [ case ~lhs:(pbool ~loc true) ~guard:None ~rhs:then_ + ; case ~lhs:(pbool ~loc false) ~guard:None ~rhs:else_ + ] + let expand ~loc:_ ~path:_ extension_name expr = let loc = expr.pexp_loc in let expansion = @@ -110,9 +116,18 @@ let expand ~loc:_ ~path:_ extension_name expr = (Extension_name.to_string extension_name) | Pexp_match (expr, cases) -> expand_match extension_name ~loc expr cases + | Pexp_ifthenelse (expr, then_, else_) -> + let else_ = + match else_ with + | Some else_ -> else_ + | None -> + Location.raise_errorf ~loc "'if%%%s' must include an else branch" + (Extension_name.to_string extension_name) + in + expand_if extension_name ~loc expr then_ else_ | _ -> Location.raise_errorf ~loc - "'%%%s' can only be used with 'let' and 'match'" + "'%%%s' can only be used with 'let', 'match', and 'if'" (Extension_name.to_string extension_name) in { expansion with pexp_attributes = expr.pexp_attributes @ expansion.pexp_attributes } diff --git a/test/test.ml b/test/test.ml index 90de6a874..9c526d27d 100644 --- a/test/test.ml +++ b/test/test.ml @@ -57,6 +57,16 @@ module Monad_example = struct 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 From 66bdeab5405a0a110bf39153e2212b30e32a434a Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 2 Sep 2016 11:02:01 +0100 Subject: [PATCH 18/59] 114.08+89 --- _oasis | 2 +- opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/_oasis b/_oasis index ec4c940b6..d8c52e993 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.4 OCamlVersion: >= 4.03.0 FindlibVersion: >= 1.3.2 Name: ppx_let -Version: 114.08+63 +Version: 114.08+89 Synopsis: Monadic let-bindings Authors: Jane Street Group, LLC Copyrights: (C) 2015-2016 Jane Street Group LLC diff --git a/opam b/opam index b02f5c062..612435f3a 100644 --- a/opam +++ b/opam @@ -18,4 +18,4 @@ depends: [ "ppx_driver" ] available: [ ocaml-version >= "4.03.0" ] -conclicts: [ "oasis" {= "0.4.7"} ] +conflicts: [ "oasis" {= "0.4.7"} ] From 61368ef5d32938a1951437bfb5dead636d5a4c30 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Dec 2016 11:20:46 +0000 Subject: [PATCH 19/59] 114.20+69 --- .gitignore | 10 ++----- META.ab | 9 ------ Makefile | 66 ++++++-------------------------------------- _oasis | 37 ------------------------- _tags | 8 ------ as_ppx/ppx.ml | 1 - configure | 5 ---- descr | 2 -- install.ml | 10 ------- myocamlbuild.ml | 14 ---------- opam => ppx_let.opam | 14 +++++----- setup.ml | 6 ---- src/jbuild | 7 ++--- test/jbuild | 2 +- 14 files changed, 22 insertions(+), 169 deletions(-) delete mode 100644 META.ab delete mode 100644 _oasis delete mode 100644 _tags delete mode 100644 as_ppx/ppx.ml delete mode 100755 configure delete mode 100644 descr delete mode 100644 install.ml delete mode 100644 myocamlbuild.ml rename opam => ppx_let.opam (65%) delete mode 100644 setup.ml diff --git a/.gitignore b/.gitignore index 8dac9f323..00d93a635 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,3 @@ -_build/ -/setup.data -/setup.log -/*.exe -/*.docdir -/*.native -/*.byte +_build +*.install + diff --git a/META.ab b/META.ab deleted file mode 100644 index 6b930b3f2..000000000 --- a/META.ab +++ /dev/null @@ -1,9 +0,0 @@ -version = "$(pkg_version)" -description = "Monadic let-bindings" -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" -plugin(ppx_driver, native) = "ppx_let.cmxs" -exists_if = "ppx_let.cma" -ppx(-ppx_driver,-custom_ppx) = "./ppx" diff --git a/Makefile b/Makefile index 8b90c0267..03bd903ea 100644 --- a/Makefile +++ b/Makefile @@ -1,68 +1,18 @@ -# 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 +default: + jbuilder build-package $(NAME) -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: install.ml setup.log setup.data - ocaml -I "$(OCAML_TOPLEVEL_PATH)" install.ml - -install: $(NAME).install +install: opam-installer -i --prefix $(PREFIX) $(NAME).install -uninstall: $(NAME).install +uninstall: 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 +reinstall: uninstall reinstall -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 +clean: + rm -rf _build -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 +.PHONY: default install uninstall reinstall clean diff --git a/_oasis b/_oasis deleted file mode 100644 index d8c52e993..000000000 --- a/_oasis +++ /dev/null @@ -1,37 +0,0 @@ -OASISFormat: 0.4 -OCamlVersion: >= 4.03.0 -FindlibVersion: >= 1.3.2 -Name: ppx_let -Version: 114.08+89 -Synopsis: Monadic let-bindings -Authors: Jane Street Group, LLC -Copyrights: (C) 2015-2016 Jane Street Group LLC -Maintainers: Jane Street Group, LLC -License: Apache-2.0 -LicenseFile: LICENSE.txt -Homepage: https://github.com/janestreet/ppx_let -Plugins: StdFiles (0.3), DevFiles (0.3) -XStdFilesAUTHORS: false -XStdFilesREADME: false -BuildTools: ocamlbuild -BetaFeatures: section_object -AlphaFeatures: ocamlbuild_more_args -XOCamlbuildPluginTags: package(js-build-tools.ocamlbuild_goodies) -FilesAB: META.ab -Description: - Part of the Jane Street's PPX rewriters collection. - -Library ppx_let - Path: src - Pack: false - Modules: Ppx_let - BuildDepends: compiler-libs.common, - ppx_core, - ppx_driver - -Executable ppx - Path: as_ppx - MainIs: ppx.ml - CompiledObject: best - BuildDepends: ppx_let, - ppx_driver diff --git a/_tags b/_tags deleted file mode 100644 index eed4cdef9..000000000 --- a/_tags +++ /dev/null @@ -1,8 +0,0 @@ -<**/*.ml{,i}>: warn(-40), no_alias_deps -<**/*>: thread -# This prevents the implicit addition of -ppx options by ocamlfind -<**/*>: predicate(custom_ppx) -: predicate(ppx_driver) -: linkall -# OASIS_START -# OASIS_STOP diff --git a/as_ppx/ppx.ml b/as_ppx/ppx.ml deleted file mode 100644 index e0c207cce..000000000 --- a/as_ppx/ppx.ml +++ /dev/null @@ -1 +0,0 @@ -Ppx_driver.run_as_ppx_rewriter () diff --git a/configure b/configure deleted file mode 100755 index 3234be22e..000000000 --- a/configure +++ /dev/null @@ -1,5 +0,0 @@ -#!/bin/sh - -# OASIS_START -make configure CONFIGUREFLAGS="$*" -# OASIS_STOP diff --git a/descr b/descr deleted file mode 100644 index fad50b245..000000000 --- a/descr +++ /dev/null @@ -1,2 +0,0 @@ -Monadic let-bindings -Part of the Jane Street's PPX rewriters collection. diff --git a/install.ml b/install.ml deleted file mode 100644 index 86d1afc2b..000000000 --- a/install.ml +++ /dev/null @@ -1,10 +0,0 @@ -#use "topfind";; -#require "js-build-tools.oasis2opam_install";; - -open Oasis2opam_install;; - -generate ~package:"ppx_let" - [ oasis_lib "ppx_let" - ; file "META" ~section:"lib" - ; oasis_exe "ppx" ~dest:"../lib/ppx_let/ppx" - ] diff --git a/myocamlbuild.ml b/myocamlbuild.ml deleted file mode 100644 index 326d29383..000000000 --- a/myocamlbuild.ml +++ /dev/null @@ -1,14 +0,0 @@ -(* OASIS_START *) -(* OASIS_STOP *) -# 3 "myocamlbuild.ml" - -module JS = Jane_street_ocamlbuild_goodies - -let dev_mode = true - -let () = - Ocamlbuild_plugin.dispatch (fun hook -> - JS.alt_cmxs_of_cmxa_rule hook; - JS.pass_predicates_to_ocamldep hook; - if dev_mode && not Sys.win32 then JS.track_external_deps hook; - dispatch_default hook) diff --git a/opam b/ppx_let.opam similarity index 65% rename from opam rename to ppx_let.opam index 612435f3a..5328321e2 100644 --- a/opam +++ b/ppx_let.opam @@ -6,16 +6,16 @@ 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] + ["jbuilder" "build-package" "ppx_let" "-j" jobs] ] depends: [ - "ocamlbuild" {build} - "oasis" {build & >= "0.4"} - "ocamlfind" {build & >= "1.3.2"} - "js-build-tools" {build} + "jbuilder" "ppx_core" "ppx_driver" ] available: [ ocaml-version >= "4.03.0" ] -conflicts: [ "oasis" {= "0.4.7"} ] +descr: " +Monadic let-bindings + +Part of the Jane Street's PPX rewriters collection. +" diff --git a/setup.ml b/setup.ml deleted file mode 100644 index f6b6bc3b8..000000000 --- a/setup.ml +++ /dev/null @@ -1,6 +0,0 @@ -(* OASIS_START *) -open OASISDynRun;; -open OASISTypes;; -(* OASIS_STOP *) - -let () = setup () diff --git a/src/jbuild b/src/jbuild index cacfa4fb0..3137f410f 100644 --- a/src/jbuild +++ b/src/jbuild @@ -1,7 +1,6 @@ (library ((name ppx_let) (public_name ppx_let) - (public_release ((kind ppx_rewriter))) - (wrapped false) - (libraries (ocamlcommon ppx_core ppx_driver)) - (preprocess ((no_preprocessing All))))) + (kind ppx_rewriter) + (libraries (compiler-libs.common ppx_core ppx_driver)) + (preprocess no_preprocessing))) diff --git a/test/jbuild b/test/jbuild index 94cb75834..fb709e3f1 100644 --- a/test/jbuild +++ b/test/jbuild @@ -1,6 +1,6 @@ (executables ((names (test)) - (preprocess (((pps (ppx_let)) All))))) + (preprocess (pps (ppx_let))))) (toplevel_expect_tests ((libraries (ppx_let)))) From b54a47319655859f8ee7a61f350acfe2f6d7063a Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 23 Dec 2016 15:32:23 +0000 Subject: [PATCH 20/59] 114.20+69 --- src/ppx_let.mli | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ppx_let.mli b/src/ppx_let.mli index 34976fd80..234ab2043 100644 --- a/src/ppx_let.mli +++ b/src/ppx_let.mli @@ -1 +1,2 @@ (* This signature is deliberately empty. *) + From c0fcf3607d1a81c79a197ba72015251bae535838 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 24 Jan 2017 16:02:53 +0000 Subject: [PATCH 21/59] 114.29+19 --- src/jbuild | 2 +- src/ppx_let.ml | 8 +++----- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/jbuild b/src/jbuild index 3137f410f..67d08b53b 100644 --- a/src/jbuild +++ b/src/jbuild @@ -2,5 +2,5 @@ ((name ppx_let) (public_name ppx_let) (kind ppx_rewriter) - (libraries (compiler-libs.common ppx_core ppx_driver)) + (libraries (ppx_core ppx_driver)) (preprocess no_preprocessing))) diff --git a/src/ppx_let.ml b/src/ppx_let.ml index 21c8de750..20cb0ca0c 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -1,6 +1,4 @@ -open! StdLabels -open Ppx_core.Std -open Parsetree +open Ppx_core open Ast_builder.Default module List = struct @@ -45,11 +43,11 @@ let expand_with_tmp_vars ~loc bindings expr ~f = | _ -> 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 -> + List.map2_exn 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 -> + List.map2_exn 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) From 0f82719c62c068576f1a774e7fded2472aed1055 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 26 Jan 2017 10:53:37 +0000 Subject: [PATCH 22/59] 114.29+68 --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 39f824987..1a14f1c2f 100644 --- a/README.md +++ b/README.md @@ -132,7 +132,7 @@ 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 +For monads, `Core.Monad.Make` produces a submodule `Let_syntax` of the appropriate form. For applicatives. The convention for these modules is to have a submodule From dc2619c18ecc2e9404153ccd601bc69a3a7b3d66 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Tue, 21 Feb 2017 17:13:30 +0000 Subject: [PATCH 23/59] 114.33+05 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index 5328321e2..c95168593 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -6,7 +6,7 @@ bug-reports: "https://github.com/janestreet/ppx_let/issues" dev-repo: "https://github.com/janestreet/ppx_let.git" license: "Apache-2.0" build: [ - ["jbuilder" "build-package" "ppx_let" "-j" jobs] +["jbuilder" "build-package" "ppx_let" "-j" jobs] ] depends: [ "jbuilder" From 407f09fe3a80c6fa27b412047dd692445e97b966 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 27 Feb 2017 15:54:03 +0000 Subject: [PATCH 24/59] 114.33+30 --- Makefile | 5 +++-- ppx_let.opam | 2 +- src/jbuild | 2 ++ test/jbuild | 2 ++ 4 files changed, 8 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 03bd903ea..9d6511116 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,4 @@ +INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) NAME := ppx_let # Default rule @@ -5,10 +6,10 @@ default: jbuilder build-package $(NAME) install: - opam-installer -i --prefix $(PREFIX) $(NAME).install + jbuilder install $(INSTALL_ARGS) uninstall: - opam-installer -u --prefix $(PREFIX) $(NAME).install + jbuilder uninstall $(INSTALL_ARGS) reinstall: uninstall reinstall diff --git a/ppx_let.opam b/ppx_let.opam index c95168593..5328321e2 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -6,7 +6,7 @@ bug-reports: "https://github.com/janestreet/ppx_let/issues" dev-repo: "https://github.com/janestreet/ppx_let.git" license: "Apache-2.0" build: [ -["jbuilder" "build-package" "ppx_let" "-j" jobs] + ["jbuilder" "build-package" "ppx_let" "-j" jobs] ] depends: [ "jbuilder" diff --git a/src/jbuild b/src/jbuild index 67d08b53b..e9c94d67c 100644 --- a/src/jbuild +++ b/src/jbuild @@ -4,3 +4,5 @@ (kind ppx_rewriter) (libraries (ppx_core ppx_driver)) (preprocess no_preprocessing))) + +(jbuild_version jane_street) diff --git a/test/jbuild b/test/jbuild index fb709e3f1..aa62245e5 100644 --- a/test/jbuild +++ b/test/jbuild @@ -4,3 +4,5 @@ (toplevel_expect_tests ((libraries (ppx_let)))) + +(jbuild_version jane_street) From dff1c815ece76cd93da4814a3fb06affebdbb92a Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 2 Mar 2017 17:25:32 +0000 Subject: [PATCH 25/59] 114.34+110 --- test/jbuild | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/jbuild b/test/jbuild index aa62245e5..a5545a4fc 100644 --- a/test/jbuild +++ b/test/jbuild @@ -2,7 +2,5 @@ ((names (test)) (preprocess (pps (ppx_let))))) -(toplevel_expect_tests - ((libraries (ppx_let)))) (jbuild_version jane_street) From e6e5196e83b98a1d19782eabd3fdcec2073712c1 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 2 Mar 2017 18:31:33 +0000 Subject: [PATCH 26/59] 114.34+110 --- Makefile | 3 +-- ppx_let.opam | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 9d6511116..d22335670 100644 --- a/Makefile +++ b/Makefile @@ -1,9 +1,8 @@ INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) -NAME := ppx_let # Default rule default: - jbuilder build-package $(NAME) + jbuilder build @install install: jbuilder install $(INSTALL_ARGS) diff --git a/ppx_let.opam b/ppx_let.opam index 5328321e2..f4f48e5a6 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -6,7 +6,7 @@ bug-reports: "https://github.com/janestreet/ppx_let/issues" dev-repo: "https://github.com/janestreet/ppx_let.git" license: "Apache-2.0" build: [ - ["jbuilder" "build-package" "ppx_let" "-j" jobs] + ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs] ] depends: [ "jbuilder" From de434fb0f80641b8cbabe2b7bf04fd90b8da736b Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 3 Mar 2017 07:53:34 +0000 Subject: [PATCH 27/59] 114.34+110 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index f4f48e5a6..fd1cc8433 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -6,7 +6,7 @@ bug-reports: "https://github.com/janestreet/ppx_let/issues" dev-repo: "https://github.com/janestreet/ppx_let.git" license: "Apache-2.0" build: [ - ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs] + ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs "@install"] ] depends: [ "jbuilder" From 8bdf299031fdfefe2db6570cb75a055b59ea5e09 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 6 Mar 2017 17:40:22 +0000 Subject: [PATCH 28/59] 114.35+03 --- README.md | 5 +++++ jbuild | 2 ++ ppx_let.opam | 3 ++- test/jbuild | 2 +- 4 files changed, 10 insertions(+), 2 deletions(-) create mode 100644 jbuild diff --git a/README.md b/README.md index 1a14f1c2f..5e35a45a3 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,8 @@ +--- +title: ppx_let +parent: ../README.md +--- + A ppx rewriter for monadic and applicative let bindings, match expressions, and if expressions. diff --git a/jbuild b/jbuild new file mode 100644 index 000000000..75b4c96cb --- /dev/null +++ b/jbuild @@ -0,0 +1,2 @@ + +(jbuild_version jane_street) diff --git a/ppx_let.opam b/ppx_let.opam index fd1cc8433..a8dbd29f7 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -9,9 +9,10 @@ build: [ ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs "@install"] ] depends: [ - "jbuilder" + "jbuilder" {build} "ppx_core" "ppx_driver" + "ocaml-migrate-parsetree" ] available: [ ocaml-version >= "4.03.0" ] descr: " diff --git a/test/jbuild b/test/jbuild index a5545a4fc..c9e1275e3 100644 --- a/test/jbuild +++ b/test/jbuild @@ -1,6 +1,6 @@ (executables ((names (test)) - (preprocess (pps (ppx_let))))) + (preprocess (pps (ppx_let ppx_driver.runner))))) (jbuild_version jane_street) From 1ed20a233fa2483a7a26154bef5aeaf9db3b043b Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 7 Mar 2017 13:49:37 +0000 Subject: [PATCH 29/59] 114.35+03 --- jbuild | 2 +- src/jbuild | 2 +- test/jbuild | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/jbuild b/jbuild index 75b4c96cb..ea8e23449 100644 --- a/jbuild +++ b/jbuild @@ -1,2 +1,2 @@ -(jbuild_version jane_street) +(jbuild_version 1) diff --git a/src/jbuild b/src/jbuild index e9c94d67c..6c9d6e805 100644 --- a/src/jbuild +++ b/src/jbuild @@ -5,4 +5,4 @@ (libraries (ppx_core ppx_driver)) (preprocess no_preprocessing))) -(jbuild_version jane_street) +(jbuild_version 1) diff --git a/test/jbuild b/test/jbuild index c9e1275e3..776c2febc 100644 --- a/test/jbuild +++ b/test/jbuild @@ -3,4 +3,4 @@ (preprocess (pps (ppx_let ppx_driver.runner))))) -(jbuild_version jane_street) +(jbuild_version 1) From e3aead1c7f9873880fb0790912531eadc7131f5d Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 7 Mar 2017 14:51:47 +0000 Subject: [PATCH 30/59] 114.35+03 --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 00d93a635..85f39e57b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ _build *.install +*.merlin From f013814aa874a96b0e0749b40123a3d762da9669 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 13 Mar 2017 14:25:46 +0000 Subject: [PATCH 31/59] 114.35+03 --- ppx_let.opam | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ppx_let.opam b/ppx_let.opam index a8dbd29f7..f35b65a3d 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -9,10 +9,10 @@ build: [ ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs "@install"] ] depends: [ - "jbuilder" {build} + "jbuilder" {build & >= "1.0+beta2"} "ppx_core" "ppx_driver" - "ocaml-migrate-parsetree" + "ocaml-migrate-parsetree" {>= "0.4"} ] available: [ ocaml-version >= "4.03.0" ] descr: " From 620861ebf144df4e49658a3be807829113cdfb0b Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 28 Mar 2017 18:32:08 +0100 Subject: [PATCH 32/59] v0.9.114.35+03 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index f35b65a3d..e878f7e3e 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -3,7 +3,7 @@ maintainer: "opensource@janestreet.com" authors: ["Jane Street Group, LLC "] 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" +dev-repo: "git+https://github.com/janestreet/ppx_let.git" license: "Apache-2.0" build: [ ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs "@install"] From c1c4a5bdcbbc2e02dafd56841a37fa573fe28ee1 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 19 Apr 2017 14:30:00 +0100 Subject: [PATCH 33/59] v0.9.114.41+37 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index e878f7e3e..a97d14ef0 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -9,7 +9,7 @@ build: [ ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs "@install"] ] depends: [ - "jbuilder" {build & >= "1.0+beta2"} + "jbuilder" {build & >= "1.0+beta8"} "ppx_core" "ppx_driver" "ocaml-migrate-parsetree" {>= "0.4"} From 244129cb283732d4aa16f1166b1fab1bdf54501a Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Thu, 11 May 2017 15:11:15 +0100 Subject: [PATCH 34/59] v0.9.114.44+47 --- README.md | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 5e35a45a3..c2a3c786a 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,5 @@ ---- -title: ppx_let -parent: ../README.md ---- +ppx_let +======= A ppx rewriter for monadic and applicative let bindings, match expressions, and if expressions. From b1bb9ae326b6ae62491e6013f0073809c3a7a6f0 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Wed, 17 May 2017 10:12:41 +0100 Subject: [PATCH 35/59] v0.9.115.00+14 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index a97d14ef0..18009793b 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -14,7 +14,7 @@ depends: [ "ppx_driver" "ocaml-migrate-parsetree" {>= "0.4"} ] -available: [ ocaml-version >= "4.03.0" ] +available: [ ocaml-version >= "4.04.1" ] descr: " Monadic let-bindings From 021fd8c86420bb8c024034ff7a2fec9b8f05374e Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Thu, 1 Jun 2017 13:33:32 +0100 Subject: [PATCH 36/59] v0.9.115.01+41 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index 18009793b..514a918db 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -6,7 +6,7 @@ bug-reports: "https://github.com/janestreet/ppx_let/issues" dev-repo: "git+https://github.com/janestreet/ppx_let.git" license: "Apache-2.0" build: [ - ["jbuilder" "build" "--only-packages" "ppx_let" "--root" "." "-j" jobs "@install"] + ["jbuilder" "build" "-p" name "-j" jobs] ] depends: [ "jbuilder" {build & >= "1.0+beta8"} From a1567331369db688738a73132964204637ec18f5 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Wed, 30 Aug 2017 09:28:46 +0100 Subject: [PATCH 37/59] v0.9.115.15+07 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index 514a918db..bc530debb 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -9,9 +9,9 @@ build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] depends: [ - "jbuilder" {build & >= "1.0+beta8"} "ppx_core" "ppx_driver" + "jbuilder" {build & >= "1.0+beta12"} "ocaml-migrate-parsetree" {>= "0.4"} ] available: [ ocaml-version >= "4.04.1" ] From 8707f0e08b99af727e0345ac939209b2d8c87d13 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Thu, 2 Nov 2017 09:29:38 +0000 Subject: [PATCH 38/59] v0.9.115.24+69 --- src/jbuild | 1 + 1 file changed, 1 insertion(+) diff --git a/src/jbuild b/src/jbuild index 6c9d6e805..b066e515f 100644 --- a/src/jbuild +++ b/src/jbuild @@ -2,6 +2,7 @@ ((name ppx_let) (public_name ppx_let) (kind ppx_rewriter) + (flags (:standard -safe-string)) (libraries (ppx_core ppx_driver)) (preprocess no_preprocessing))) From 71e323b1d392fc53ac1a97fbfb54ec0642f649f9 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Thu, 16 Nov 2017 09:38:28 +0800 Subject: [PATCH 39/59] v0.9.116.00+32 --- test/jbuild | 1 + 1 file changed, 1 insertion(+) diff --git a/test/jbuild b/test/jbuild index 776c2febc..7917744c2 100644 --- a/test/jbuild +++ b/test/jbuild @@ -1,5 +1,6 @@ (executables ((names (test)) + (flags (:standard -safe-string)) (preprocess (pps (ppx_let ppx_driver.runner))))) From ef3064c489894d9d86a8ae4ac330a0303230c506 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Mon, 26 Feb 2018 15:40:35 +0000 Subject: [PATCH 40/59] update dep on migrate-parsetree to new version --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index bc530debb..f8112c827 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -12,7 +12,7 @@ depends: [ "ppx_core" "ppx_driver" "jbuilder" {build & >= "1.0+beta12"} - "ocaml-migrate-parsetree" {>= "0.4"} + "ocaml-migrate-parsetree" {>= "1.0"} ] available: [ ocaml-version >= "4.04.1" ] descr: " From a4d4fb22efecf5bfb4409283147efb1e60e9157f Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Tue, 27 Feb 2018 18:08:50 +0000 Subject: [PATCH 41/59] v0.10.116.15+15 --- src/jbuild | 11 ++++++----- test/jbuild | 5 +++-- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/jbuild b/src/jbuild index b066e515f..9f0d9678f 100644 --- a/src/jbuild +++ b/src/jbuild @@ -1,9 +1,10 @@ -(library - ((name ppx_let) +(library ( + (name ppx_let) (public_name ppx_let) - (kind ppx_rewriter) - (flags (:standard -safe-string)) - (libraries (ppx_core ppx_driver)) + (kind ppx_rewriter) + (flags (:standard -safe-string)) + (libraries (ppx_core ppx_driver)) (preprocess no_preprocessing))) + (jbuild_version 1) diff --git a/test/jbuild b/test/jbuild index 7917744c2..4d46bc57a 100644 --- a/test/jbuild +++ b/test/jbuild @@ -1,7 +1,8 @@ -(executables - ((names (test)) +(executables ( + (names (test)) (flags (:standard -safe-string)) (preprocess (pps (ppx_let ppx_driver.runner))))) + (jbuild_version 1) From d690b73b9f6d528888e588bad4033003d0f43581 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Tue, 6 Mar 2018 10:37:08 +0000 Subject: [PATCH 42/59] v0.10.116.16+14 --- src/jbuild | 1 - test/jbuild | 1 - 2 files changed, 2 deletions(-) diff --git a/src/jbuild b/src/jbuild index 9f0d9678f..cd2e6bc43 100644 --- a/src/jbuild +++ b/src/jbuild @@ -6,5 +6,4 @@ (libraries (ppx_core ppx_driver)) (preprocess no_preprocessing))) - (jbuild_version 1) diff --git a/test/jbuild b/test/jbuild index 4d46bc57a..03a426849 100644 --- a/test/jbuild +++ b/test/jbuild @@ -4,5 +4,4 @@ (preprocess (pps (ppx_let ppx_driver.runner))))) - (jbuild_version 1) From 832748da991524634cbbac7baa53a7542d662259 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Fri, 16 Mar 2018 15:08:08 +0000 Subject: [PATCH 43/59] v0.11.116.17+187 --- CHANGES.md | 4 ++++ ppx_let.opam | 6 +++--- src/jbuild | 2 +- src/ppx_let.ml | 5 +++-- test/jbuild | 2 +- 5 files changed, 12 insertions(+), 7 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 03abc5dce..b84af5327 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +## v0.11 + +- Depend on ppxlib instead of (now deprecated) ppx\_core and ppx\_driver. + ## 113.43.00 - Dropped `Open_in_body` support from ppx\_let, since it was only ever used diff --git a/ppx_let.opam b/ppx_let.opam index f8112c827..94dc50ac5 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -9,10 +9,10 @@ build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] depends: [ - "ppx_core" - "ppx_driver" - "jbuilder" {build & >= "1.0+beta12"} + "base" + "jbuilder" {build & >= "1.0+beta18.1"} "ocaml-migrate-parsetree" {>= "1.0"} + "ppxlib" {>= "0.1.1"} ] available: [ ocaml-version >= "4.04.1" ] descr: " diff --git a/src/jbuild b/src/jbuild index cd2e6bc43..e4ada02f2 100644 --- a/src/jbuild +++ b/src/jbuild @@ -3,7 +3,7 @@ (public_name ppx_let) (kind ppx_rewriter) (flags (:standard -safe-string)) - (libraries (ppx_core ppx_driver)) + (libraries (base ppxlib)) (preprocess no_preprocessing))) (jbuild_version 1) diff --git a/src/ppx_let.ml b/src/ppx_let.ml index 20cb0ca0c..e44d12324 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -1,4 +1,5 @@ -open Ppx_core +open Base +open Ppxlib open Ast_builder.Default module List = struct @@ -140,7 +141,7 @@ let ext extension_name = ;; let () = - Ppx_driver.register_transformation "let" + Driver.register_transformation "let" ~extensions:[ ext Bind; ext Bind_open; diff --git a/test/jbuild b/test/jbuild index 03a426849..c018f5a9c 100644 --- a/test/jbuild +++ b/test/jbuild @@ -1,7 +1,7 @@ (executables ( (names (test)) (flags (:standard -safe-string)) - (preprocess (pps (ppx_let ppx_driver.runner))))) + (preprocess (pps (ppx_let ppxlib.runner))))) (jbuild_version 1) From 2fc4a431908d3b5418bdfed707ad3e51ef209d05 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Mon, 19 Mar 2018 10:25:08 +0000 Subject: [PATCH 44/59] v0.11.116.17+187 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index 94dc50ac5..ff2a3f3fd 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -12,7 +12,7 @@ depends: [ "base" "jbuilder" {build & >= "1.0+beta18.1"} "ocaml-migrate-parsetree" {>= "1.0"} - "ppxlib" {>= "0.1.1"} + "ppxlib" {>= "0.1.0"} ] available: [ ocaml-version >= "4.04.1" ] descr: " From 1081fc7e34635b17747d793f8d58cbe5cfdb17bc Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Thu, 29 Mar 2018 15:44:56 +0100 Subject: [PATCH 45/59] v0.11.117.00+101 --- src/jbuild | 1 - test/jbuild | 1 - 2 files changed, 2 deletions(-) diff --git a/src/jbuild b/src/jbuild index e4ada02f2..b48b4f4ae 100644 --- a/src/jbuild +++ b/src/jbuild @@ -2,7 +2,6 @@ (name ppx_let) (public_name ppx_let) (kind ppx_rewriter) - (flags (:standard -safe-string)) (libraries (base ppxlib)) (preprocess no_preprocessing))) diff --git a/test/jbuild b/test/jbuild index c018f5a9c..6bf70a34f 100644 --- a/test/jbuild +++ b/test/jbuild @@ -1,6 +1,5 @@ (executables ( (names (test)) - (flags (:standard -safe-string)) (preprocess (pps (ppx_let ppxlib.runner))))) From 488849e4ee32d79e1f580e5ebee7a57f495c9ed5 Mon Sep 17 00:00:00 2001 From: Thomas Refis Date: Thu, 19 Apr 2018 10:04:27 +0100 Subject: [PATCH 46/59] v0.11.117.03+59 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index ff2a3f3fd..a56d70015 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -14,7 +14,7 @@ depends: [ "ocaml-migrate-parsetree" {>= "1.0"} "ppxlib" {>= "0.1.0"} ] -available: [ ocaml-version >= "4.04.1" ] +available: [ ocaml-version >= "4.04.2" ] descr: " Monadic let-bindings From d24beea9cb03176b5cb1dec57b9c700a95d4408a Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Wed, 23 May 2018 17:00:52 +0100 Subject: [PATCH 47/59] v0.11.117.08+54 --- CONTRIBUTING.md | 66 ++++++++++++++++ LICENSE.md | 21 +++++ LICENSE.txt | 202 ------------------------------------------------ Makefile | 2 +- ppx_let.opam | 2 +- 5 files changed, 89 insertions(+), 204 deletions(-) create mode 100644 CONTRIBUTING.md create mode 100644 LICENSE.md delete mode 100644 LICENSE.txt diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 000000000..96ec2d75c --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,66 @@ +This repository contains open source software that is developed and +maintained by [Jane Street][js]. + +Contributions to this project are welcome and should be submitted via +GitHub pull requests. + +Signing contributions +--------------------- + +We require that you sign your contributions. Your signature certifies +that you wrote the patch or otherwise have the right to pass it on as +an open-source patch. The rules are pretty simple: if you can certify +the below (from [developercertificate.org][dco]): + +``` +Developer Certificate of Origin +Version 1.1 + +Copyright (C) 2004, 2006 The Linux Foundation and its contributors. +1 Letterman Drive +Suite D4700 +San Francisco, CA, 94129 + +Everyone is permitted to copy and distribute verbatim copies of this +license document, but changing it is not allowed. + + +Developer's Certificate of Origin 1.1 + +By making a contribution to this project, I certify that: + +(a) The contribution was created in whole or in part by me and I + have the right to submit it under the open source license + indicated in the file; or + +(b) The contribution is based upon previous work that, to the best + of my knowledge, is covered under an appropriate open source + license and I have the right under that license to submit that + work with modifications, whether created in whole or in part + by me, under the same open source license (unless I am + permitted to submit under a different license), as indicated + in the file; or + +(c) The contribution was provided directly to me by some other + person who certified (a), (b) or (c) and I have not modified + it. + +(d) I understand and agree that this project and the contribution + are public and that a record of the contribution (including all + personal information I submit with it, including my sign-off) is + maintained indefinitely and may be redistributed consistent with + this project or the open source license(s) involved. +``` + +Then you just add a line to every git commit message: + +``` +Signed-off-by: Joe Smith +``` + +Use your real name (sorry, no pseudonyms or anonymous contributions.) + +If you set your `user.name` and `user.email` git configs, you can sign +your commit automatically with git commit -s. + +[dco]: http://developercertificate.org/ diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 000000000..3a1a8084a --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +The MIT License + +Copyright (c) 2015--2018 Jane Street Group, LLC + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/LICENSE.txt b/LICENSE.txt deleted file mode 100644 index d64569567..000000000 --- a/LICENSE.txt +++ /dev/null @@ -1,202 +0,0 @@ - - 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. diff --git a/Makefile b/Makefile index d22335670..2773ca916 100644 --- a/Makefile +++ b/Makefile @@ -10,7 +10,7 @@ install: uninstall: jbuilder uninstall $(INSTALL_ARGS) -reinstall: uninstall reinstall +reinstall: uninstall install clean: rm -rf _build diff --git a/ppx_let.opam b/ppx_let.opam index a56d70015..486d4c8e5 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -4,7 +4,7 @@ authors: ["Jane Street Group, LLC "] homepage: "https://github.com/janestreet/ppx_let" bug-reports: "https://github.com/janestreet/ppx_let/issues" dev-repo: "git+https://github.com/janestreet/ppx_let.git" -license: "Apache-2.0" +license: "MIT" build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] From 1c3bd075d7bb84f26a8543cf466d7f36a6b5e6a7 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Thu, 7 Jun 2018 11:39:27 +0100 Subject: [PATCH 48/59] v0.11.117.10+09 --- CHANGES.md | 5 +++++ README.md | 17 ++++++++++++----- src/ppx_let.ml | 40 ++++++++++++++++++++++------------------ test/test.ml | 6 ++++++ 4 files changed, 45 insertions(+), 23 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index b84af5327..38594829d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +## git version + +- Support for `%map.A.B.C` syntax to use values from a specific module, rather + than the one in scope. + ## v0.11 - Depend on ppxlib instead of (now deprecated) ppx\_core and ppx\_driver. diff --git a/README.md b/README.md index c2a3c786a..389a8dbda 100644 --- a/README.md +++ b/README.md @@ -131,15 +131,22 @@ 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`. +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`. + +Alternatively, the extension can use values from a `Let_syntax` module +other than the one in scope. If you write `%map.A.B.C` instead of +`%map`, the expansion will use `A.B.C.Let_syntax.map` instead of +`Let_syntax.map` (and similarly for all extension points). For monads, `Core.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 +For applicatives, the convention for these modules is to have a submodule +`Let_syntax` of the form: ```ocaml module Let_syntax : sig diff --git a/src/ppx_let.ml b/src/ppx_let.ml index e44d12324..8c5fa76cb 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -29,12 +29,16 @@ module Extension_name = struct | Map_open -> "map_open" end -let let_syntax = "Let_syntax" +let let_syntax ~modul : Longident.t = + match modul with + | None -> Lident "Let_syntax" + | Some id -> Ldot (id.txt, "Let_syntax") -let open_on_rhs ~loc = Located.mk ~loc (Longident.Ldot (Lident let_syntax, "Open_on_rhs" )) +let open_on_rhs ~loc ~modul = + Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs" )) -let eoperator ~loc func = - let lid : Longident.t = Ldot (Longident.Lident let_syntax, func) in +let eoperator ~loc ~modul func = + let lid : Longident.t = Ldot (let_syntax ~modul, func) in pexp_ident ~loc (Located.mk ~loc lid) ;; @@ -54,9 +58,9 @@ let expand_with_tmp_vars ~loc bindings expr ~f = pexp_let ~loc Nonrecursive s_lhs_tmp_var (f ~loc s_rhs_tmp_var expr) ;; -let bind_apply ~loc extension_name ~arg ~fn = +let bind_apply ~loc ~modul extension_name ~arg ~fn = pexp_apply ~loc - (eoperator ~loc (Extension_name.operator_name extension_name)) + (eoperator ~loc ~modul (Extension_name.operator_name extension_name)) [(Nolabel, arg); (Labelled "f", fn)] ;; @@ -67,13 +71,13 @@ let maybe_open extension_name ~to_open:module_to_open expr = | Bind_open | Map_open -> pexp_open ~loc Override (module_to_open ~loc) expr ;; -let expand_let extension_name ~loc bindings body = +let expand_let extension_name ~loc ~modul 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]) + eapply ~loc (eoperator ~loc ~modul "both") [e; acc]) in (* Build pattern [(P1, (P2, ...))] *) let nested_patterns = @@ -82,13 +86,13 @@ let expand_let extension_name ~loc bindings body = let loc = p.ppat_loc in ppat_tuple ~loc [p; acc]) in - bind_apply ~loc extension_name ~arg:nested_boths + bind_apply ~loc ~modul extension_name ~arg:nested_boths ~fn:(pexp_fun ~loc Nolabel None nested_patterns body) ;; -let expand_match extension_name ~loc expr cases = - bind_apply ~loc extension_name - ~arg:(maybe_open extension_name ~to_open:open_on_rhs expr) +let expand_match extension_name ~loc ~modul expr cases = + bind_apply ~loc ~modul extension_name + ~arg:(maybe_open extension_name ~to_open:(open_on_rhs ~modul) expr) ~fn:(pexp_function ~loc cases) ;; @@ -98,7 +102,7 @@ let expand_if extension_name ~loc expr then_ else_ = ; case ~lhs:(pbool ~loc false) ~guard:None ~rhs:else_ ] -let expand ~loc:_ ~path:_ extension_name expr = +let expand ~loc:_ ~path:_ ~arg:modul extension_name expr = let loc = expr.pexp_loc in let expansion = match expr.pexp_desc with @@ -106,15 +110,15 @@ let expand ~loc:_ ~path:_ extension_name expr = let bindings = List.map bindings ~f:(fun vb -> { vb with - pvb_expr = maybe_open extension_name ~to_open:open_on_rhs vb.pvb_expr; + pvb_expr = maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr; }) in - expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name) + expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name ~modul) | 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 + expand_match extension_name ~loc ~modul expr cases | Pexp_ifthenelse (expr, then_, else_) -> let else_ = match else_ with @@ -123,7 +127,7 @@ let expand ~loc:_ ~path:_ extension_name expr = Location.raise_errorf ~loc "'if%%%s' must include an else branch" (Extension_name.to_string extension_name) in - expand_if extension_name ~loc expr then_ else_ + expand_if extension_name ~loc ~modul expr then_ else_ | _ -> Location.raise_errorf ~loc "'%%%s' can only be used with 'let', 'match', and 'if'" @@ -133,7 +137,7 @@ let expand ~loc:_ ~path:_ extension_name expr = ;; let ext extension_name = - Extension.declare + Extension.declare_with_path_arg (Extension_name.to_string extension_name) Extension.Context.expression Ast_pattern.(single_expr_payload __) diff --git a/test/test.ml b/test/test.ml index 9c526d27d..5406416c7 100644 --- a/test/test.ml +++ b/test/test.ml @@ -138,3 +138,9 @@ module Applicative_example = struct | 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 From bdb7fe397e6db2dbc565c7c62ad0b6f763b52f75 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Mon, 13 Aug 2018 10:25:18 +0100 Subject: [PATCH 49/59] v0.11.117.19+179 --- src/ppx_let.ml | 12 ++++++++++++ test/test.ml | 2 +- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/ppx_let.ml b/src/ppx_let.ml index 8c5fa76cb..c1848810a 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -109,7 +109,19 @@ let expand ~loc:_ ~path:_ ~arg:modul extension_name expr = | Pexp_let (Nonrecursive, bindings, expr) -> let bindings = List.map bindings ~f:(fun vb -> + let pvb_pat = + (* Temporary hack tentatively detecting that the parser + has expanded `let x : t = e` into `let x : t = (e : t)`. + + For reference, here is the relevant part of the parser: + https://github.com/ocaml/ocaml/blob/4.07/parsing/parser.mly#L1628 *) + match vb.pvb_pat.ppat_desc, vb.pvb_expr.pexp_desc with + | Ppat_constraint (p, { ptyp_desc = Ptyp_poly ([], t1); _ }), + Pexp_constraint (_, t2) when phys_equal t1 t2 -> p + | _ -> vb.pvb_pat + in { vb with + pvb_pat; pvb_expr = maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr; }) in diff --git a/test/test.ml b/test/test.ml index 5406416c7..0f035fa18 100644 --- a/test/test.ml +++ b/test/test.ml @@ -41,7 +41,7 @@ module Monad_example = struct return (x + y + (u * v)) let _mg a : _ X.t = - let%map x = a in + let%map x : int X.t = a in x + 1 let _mg' a b c : _ X.t = From 9c3d7fa2d69fd2ac184b7db76277392df132dc0b Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Thu, 23 Aug 2018 09:56:24 +0100 Subject: [PATCH 50/59] v0.11.119.00+92 --- expander/jbuild | 7 ++ expander/ppx_let_expander.ml | 151 +++++++++++++++++++++++++++++++++ expander/ppx_let_expander.mli | 17 ++++ src/jbuild | 2 +- src/ppx_let.ml | 153 +--------------------------------- src/ppx_let.mli | 2 - 6 files changed, 179 insertions(+), 153 deletions(-) create mode 100644 expander/jbuild create mode 100644 expander/ppx_let_expander.ml create mode 100644 expander/ppx_let_expander.mli diff --git a/expander/jbuild b/expander/jbuild new file mode 100644 index 000000000..f1666c496 --- /dev/null +++ b/expander/jbuild @@ -0,0 +1,7 @@ +(library ( + (name ppx_let_expander) + (public_name ppx_let.expander) + (libraries (base ppxlib)) + (preprocess no_preprocessing))) + +(jbuild_version 1) diff --git a/expander/ppx_let_expander.ml b/expander/ppx_let_expander.ml new file mode 100644 index 000000000..a48740a2b --- /dev/null +++ b/expander/ppx_let_expander.ml @@ -0,0 +1,151 @@ +open Base +open Ppxlib +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 ~modul : Longident.t = + match modul with + | None -> Lident "Let_syntax" + | Some id -> Ldot (id.txt, "Let_syntax") + +let open_on_rhs ~loc ~modul = + Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs" )) + +let eoperator ~loc ~modul func = + let lid : Longident.t = Ldot (let_syntax ~modul, 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_exn 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_exn 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 ~modul extension_name ~arg ~fn = + pexp_apply ~loc + (eoperator ~loc ~modul (Extension_name.operator_name extension_name)) + [(Nolabel, arg); (Labelled "f", fn)] +;; + +let maybe_open extension_name ~to_open:module_to_open expr = + let loc = expr.pexp_loc in + 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 ~modul bindings body = + if List.is_empty bindings + then invalid_arg "expand_let: list of bindings must be non-empty"; + (* 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 ~modul "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 ~modul extension_name ~arg:nested_boths + ~fn:(pexp_fun ~loc Nolabel None nested_patterns body) +;; + +let expand_match extension_name ~loc ~modul expr cases = + bind_apply ~loc ~modul extension_name + ~arg:(maybe_open extension_name ~to_open:(open_on_rhs ~modul) expr) + ~fn:(pexp_function ~loc cases) +;; + +let expand_if extension_name ~loc expr then_ else_ = + expand_match extension_name ~loc expr + [ case ~lhs:(pbool ~loc true) ~guard:None ~rhs:then_ + ; case ~lhs:(pbool ~loc false) ~guard:None ~rhs:else_ + ] + +let expand ~modul 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 -> + let pvb_pat = + (* Temporary hack tentatively detecting that the parser + has expanded `let x : t = e` into `let x : t = (e : t)`. + + For reference, here is the relevant part of the parser: + https://github.com/ocaml/ocaml/blob/4.07/parsing/parser.mly#L1628 *) + match vb.pvb_pat.ppat_desc, vb.pvb_expr.pexp_desc with + | Ppat_constraint (p, { ptyp_desc = Ptyp_poly ([], t1); _ }), + Pexp_constraint (_, t2) when phys_equal t1 t2 -> p + | _ -> vb.pvb_pat + in + { vb with + pvb_pat; + pvb_expr = maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr; + }) + in + expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name ~modul) + | 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 ~modul expr cases + | Pexp_ifthenelse (expr, then_, else_) -> + let else_ = + match else_ with + | Some else_ -> else_ + | None -> + Location.raise_errorf ~loc "'if%%%s' must include an else branch" + (Extension_name.to_string extension_name) + in + expand_if extension_name ~loc ~modul expr then_ else_ + | _ -> + Location.raise_errorf ~loc + "'%%%s' can only be used with 'let', 'match', and 'if'" + (Extension_name.to_string extension_name) + in + { expansion with pexp_attributes = expr.pexp_attributes @ expansion.pexp_attributes } +;; diff --git a/expander/ppx_let_expander.mli b/expander/ppx_let_expander.mli new file mode 100644 index 000000000..f000b2b24 --- /dev/null +++ b/expander/ppx_let_expander.mli @@ -0,0 +1,17 @@ +open Ppxlib + +module Extension_name : sig + type t = + | Bind + | Bind_open + | Map + | Map_open + val to_string : t -> string +end + +val expand + : modul:longident loc option + -> Extension_name.t + -> expression + -> expression + diff --git a/src/jbuild b/src/jbuild index b48b4f4ae..3c8e6e818 100644 --- a/src/jbuild +++ b/src/jbuild @@ -2,7 +2,7 @@ (name ppx_let) (public_name ppx_let) (kind ppx_rewriter) - (libraries (base ppxlib)) + (libraries (base ppxlib ppx_let_expander)) (preprocess no_preprocessing))) (jbuild_version 1) diff --git a/src/ppx_let.ml b/src/ppx_let.ml index c1848810a..5b821786a 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -1,159 +1,12 @@ -open Base open Ppxlib -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 ~modul : Longident.t = - match modul with - | None -> Lident "Let_syntax" - | Some id -> Ldot (id.txt, "Let_syntax") - -let open_on_rhs ~loc ~modul = - Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs" )) - -let eoperator ~loc ~modul func = - let lid : Longident.t = Ldot (let_syntax ~modul, 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_exn 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_exn 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 ~modul extension_name ~arg ~fn = - pexp_apply ~loc - (eoperator ~loc ~modul (Extension_name.operator_name extension_name)) - [(Nolabel, arg); (Labelled "f", fn)] -;; - -let maybe_open extension_name ~to_open:module_to_open expr = - let loc = expr.pexp_loc in - 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 ~modul 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 ~modul "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 ~modul extension_name ~arg:nested_boths - ~fn:(pexp_fun ~loc Nolabel None nested_patterns body) -;; - -let expand_match extension_name ~loc ~modul expr cases = - bind_apply ~loc ~modul extension_name - ~arg:(maybe_open extension_name ~to_open:(open_on_rhs ~modul) expr) - ~fn:(pexp_function ~loc cases) -;; - -let expand_if extension_name ~loc expr then_ else_ = - expand_match extension_name ~loc expr - [ case ~lhs:(pbool ~loc true) ~guard:None ~rhs:then_ - ; case ~lhs:(pbool ~loc false) ~guard:None ~rhs:else_ - ] - -let expand ~loc:_ ~path:_ ~arg:modul 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 -> - let pvb_pat = - (* Temporary hack tentatively detecting that the parser - has expanded `let x : t = e` into `let x : t = (e : t)`. - - For reference, here is the relevant part of the parser: - https://github.com/ocaml/ocaml/blob/4.07/parsing/parser.mly#L1628 *) - match vb.pvb_pat.ppat_desc, vb.pvb_expr.pexp_desc with - | Ppat_constraint (p, { ptyp_desc = Ptyp_poly ([], t1); _ }), - Pexp_constraint (_, t2) when phys_equal t1 t2 -> p - | _ -> vb.pvb_pat - in - { vb with - pvb_pat; - pvb_expr = maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr; - }) - in - expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name ~modul) - | 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 ~modul expr cases - | Pexp_ifthenelse (expr, then_, else_) -> - let else_ = - match else_ with - | Some else_ -> else_ - | None -> - Location.raise_errorf ~loc "'if%%%s' must include an else branch" - (Extension_name.to_string extension_name) - in - expand_if extension_name ~loc ~modul expr then_ else_ - | _ -> - Location.raise_errorf ~loc - "'%%%s' can only be used with 'let', 'match', and 'if'" - (Extension_name.to_string extension_name) - in - { expansion with pexp_attributes = expr.pexp_attributes @ expansion.pexp_attributes } -;; let ext extension_name = Extension.declare_with_path_arg - (Extension_name.to_string extension_name) + (Ppx_let_expander.Extension_name.to_string extension_name) Extension.Context.expression Ast_pattern.(single_expr_payload __) - (expand extension_name) + (fun ~loc:_ ~path:_ ~arg expr -> + Ppx_let_expander.expand extension_name ~modul:arg expr) ;; let () = diff --git a/src/ppx_let.mli b/src/ppx_let.mli index 234ab2043..e69de29bb 100644 --- a/src/ppx_let.mli +++ b/src/ppx_let.mli @@ -1,2 +0,0 @@ -(* This signature is deliberately empty. *) - From 18e2e4319f86c7b4858823b408f32a0dbd21e5fc Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Tue, 6 Nov 2018 09:48:30 +0000 Subject: [PATCH 51/59] v0.11.120.08+153 --- CONTRIBUTING.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 96ec2d75c..45e1a22b9 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -64,3 +64,4 @@ If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with git commit -s. [dco]: http://developercertificate.org/ +[js]: https://opensource.janestreet.com/ From 6b33250bda52e69cef7f82aef40993ff4587ab45 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Thu, 8 Nov 2018 10:05:59 +0000 Subject: [PATCH 52/59] v0.11.120.09+50 --- ppx_let.opam | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/ppx_let.opam b/ppx_let.opam index 486d4c8e5..909b792b8 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -10,9 +10,8 @@ build: [ ] depends: [ "base" - "jbuilder" {build & >= "1.0+beta18.1"} - "ocaml-migrate-parsetree" {>= "1.0"} - "ppxlib" {>= "0.1.0"} + "jbuilder" {build & >= "1.0+beta18.1"} + "ppxlib" {>= "0.1.0"} ] available: [ ocaml-version >= "4.04.2" ] descr: " From de8312ead02b59379c718e08e0796dc31613225b Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Wed, 16 Jan 2019 10:57:51 +0000 Subject: [PATCH 53/59] v0.12-preview.120.18+252 --- LICENSE.md | 2 +- Makefile | 9 ++-- dune | 0 dune-project | 1 + expander/dune | 2 + expander/jbuild | 7 --- expander/ppx_let_expander.ml | 79 ++++++++++++++++++++++------------ expander/ppx_let_expander.mli | 8 +--- jbuild | 2 - ppx_let.opam | 16 +++---- src/dune | 2 + src/jbuild | 8 ---- src/ppx_let.ml | 10 ++--- src/ppx_let.mli | 1 + test/dune | 1 + test/jbuild | 6 --- test/test-locations.mlt | 17 ++++++-- test/test.ml | 81 +++++++++++++++++++++++------------ 18 files changed, 143 insertions(+), 109 deletions(-) create mode 100644 dune create mode 100644 dune-project create mode 100644 expander/dune delete mode 100644 expander/jbuild delete mode 100644 jbuild create mode 100644 src/dune delete mode 100644 src/jbuild create mode 100644 test/dune delete mode 100644 test/jbuild diff --git a/LICENSE.md b/LICENSE.md index 3a1a8084a..54ac5432f 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,6 +1,6 @@ The MIT License -Copyright (c) 2015--2018 Jane Street Group, LLC +Copyright (c) 2015--2019 Jane Street Group, LLC Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/Makefile b/Makefile index 2773ca916..1965878e4 100644 --- a/Makefile +++ b/Makefile @@ -1,18 +1,17 @@ INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) -# Default rule default: - jbuilder build @install + dune build install: - jbuilder install $(INSTALL_ARGS) + dune install $(INSTALL_ARGS) uninstall: - jbuilder uninstall $(INSTALL_ARGS) + dune uninstall $(INSTALL_ARGS) reinstall: uninstall install clean: - rm -rf _build + dune clean .PHONY: default install uninstall reinstall clean diff --git a/dune b/dune new file mode 100644 index 000000000..e69de29bb diff --git a/dune-project b/dune-project new file mode 100644 index 000000000..598db5612 --- /dev/null +++ b/dune-project @@ -0,0 +1 @@ +(lang dune 1.5) \ No newline at end of file diff --git a/expander/dune b/expander/dune new file mode 100644 index 000000000..2ced86cfa --- /dev/null +++ b/expander/dune @@ -0,0 +1,2 @@ +(library (name ppx_let_expander) (public_name ppx_let.expander) + (libraries base ppxlib) (preprocess no_preprocessing)) \ No newline at end of file diff --git a/expander/jbuild b/expander/jbuild deleted file mode 100644 index f1666c496..000000000 --- a/expander/jbuild +++ /dev/null @@ -1,7 +0,0 @@ -(library ( - (name ppx_let_expander) - (public_name ppx_let.expander) - (libraries (base ppxlib)) - (preprocess no_preprocessing))) - -(jbuild_version 1) diff --git a/expander/ppx_let_expander.ml b/expander/ppx_let_expander.ml index a48740a2b..c6eabf695 100644 --- a/expander/ppx_let_expander.ml +++ b/expander/ppx_let_expander.ml @@ -9,6 +9,7 @@ module List = struct match l with | [] -> invalid_arg "List.reduce_exn" | hd :: tl -> fold_left tl ~init:hd ~f + ;; end module Extension_name = struct @@ -20,22 +21,26 @@ module Extension_name = struct let operator_name = function | Bind | Bind_open -> "bind" - | Map | Map_open -> "map" + | Map | Map_open -> "map" + ;; - let to_string = function - | Bind -> "bind" + let to_string = function + | Bind -> "bind" | Bind_open -> "bind_open" - | Map -> "map" - | Map_open -> "map_open" + | Map -> "map" + | Map_open -> "map_open" + ;; end let let_syntax ~modul : Longident.t = match modul with | None -> Lident "Let_syntax" | Some id -> Ldot (id.txt, "Let_syntax") +;; let open_on_rhs ~loc ~modul = - Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs" )) + Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs")) +;; let eoperator ~loc ~modul func = let lid : Longident.t = Ldot (let_syntax ~modul, func) in @@ -44,30 +49,33 @@ let eoperator ~loc ~modul func = let expand_with_tmp_vars ~loc bindings expr ~f = match bindings with - | [_] -> f ~loc bindings expr + | [ _ ] -> f ~loc bindings expr | _ -> - let tmp_vars = List.map bindings ~f:(fun _ -> gen_symbol ~prefix:"__let_syntax" ()) in + 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_exn 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_exn bindings tmp_vars ~f:(fun vb var -> + List.map2_exn 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 ~modul extension_name ~arg ~fn = - pexp_apply ~loc + pexp_apply + ~loc (eoperator ~loc ~modul (Extension_name.operator_name extension_name)) - [(Nolabel, arg); (Labelled "f", fn)] + [ Nolabel, arg; Labelled "f", fn ] ;; let maybe_open extension_name ~to_open:module_to_open expr = let loc = expr.pexp_loc in match (extension_name : Extension_name.t) with - | Bind | Map -> expr + | Bind | Map -> expr | Bind_open | Map_open -> pexp_open ~loc Override (module_to_open ~loc) expr ;; @@ -79,30 +87,41 @@ let expand_let extension_name ~loc ~modul bindings body = 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 ~modul "both") [e; acc]) + eapply ~loc (eoperator ~loc ~modul "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]) + ppat_tuple ~loc [ p; acc ]) in - bind_apply ~loc ~modul extension_name ~arg:nested_boths + bind_apply + ~loc + ~modul + extension_name + ~arg:nested_boths ~fn:(pexp_fun ~loc Nolabel None nested_patterns body) ;; let expand_match extension_name ~loc ~modul expr cases = - bind_apply ~loc ~modul extension_name + bind_apply + ~loc + ~modul + extension_name ~arg:(maybe_open extension_name ~to_open:(open_on_rhs ~modul) expr) ~fn:(pexp_function ~loc cases) ;; let expand_if extension_name ~loc expr then_ else_ = - expand_match extension_name ~loc expr - [ case ~lhs:(pbool ~loc true) ~guard:None ~rhs:then_ + expand_match + extension_name + ~loc + expr + [ case ~lhs:(pbool ~loc true) ~guard:None ~rhs:then_ ; case ~lhs:(pbool ~loc false) ~guard:None ~rhs:else_ ] +;; let expand ~modul extension_name expr = let loc = expr.pexp_loc in @@ -118,32 +137,38 @@ let expand ~modul extension_name expr = For reference, here is the relevant part of the parser: https://github.com/ocaml/ocaml/blob/4.07/parsing/parser.mly#L1628 *) match vb.pvb_pat.ppat_desc, vb.pvb_expr.pexp_desc with - | Ppat_constraint (p, { ptyp_desc = Ptyp_poly ([], t1); _ }), - Pexp_constraint (_, t2) when phys_equal t1 t2 -> p + | ( Ppat_constraint (p, { ptyp_desc = Ptyp_poly ([], t1); _ }) + , Pexp_constraint (_, t2) ) + when phys_equal t1 t2 -> p | _ -> vb.pvb_pat in { vb with - pvb_pat; - pvb_expr = maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr; + pvb_pat + ; pvb_expr = + maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr }) in expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name ~modul) | Pexp_let (Recursive, _, _) -> - Location.raise_errorf ~loc "'let%%%s' may not be 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 ~modul expr cases + | Pexp_match (expr, cases) -> expand_match extension_name ~loc ~modul expr cases | Pexp_ifthenelse (expr, then_, else_) -> let else_ = match else_ with | Some else_ -> else_ | None -> - Location.raise_errorf ~loc "'if%%%s' must include an else branch" + Location.raise_errorf + ~loc + "'if%%%s' must include an else branch" (Extension_name.to_string extension_name) in expand_if extension_name ~loc ~modul expr then_ else_ | _ -> - Location.raise_errorf ~loc + Location.raise_errorf + ~loc "'%%%s' can only be used with 'let', 'match', and 'if'" (Extension_name.to_string extension_name) in diff --git a/expander/ppx_let_expander.mli b/expander/ppx_let_expander.mli index f000b2b24..71333f8a8 100644 --- a/expander/ppx_let_expander.mli +++ b/expander/ppx_let_expander.mli @@ -6,12 +6,8 @@ module Extension_name : sig | Bind_open | Map | Map_open + val to_string : t -> string end -val expand - : modul:longident loc option - -> Extension_name.t - -> expression - -> expression - +val expand : modul:longident loc option -> Extension_name.t -> expression -> expression diff --git a/jbuild b/jbuild deleted file mode 100644 index ea8e23449..000000000 --- a/jbuild +++ /dev/null @@ -1,2 +0,0 @@ - -(jbuild_version 1) diff --git a/ppx_let.opam b/ppx_let.opam index 909b792b8..331f34e78 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -1,21 +1,21 @@ -opam-version: "1.2" +opam-version: "2.0" maintainer: "opensource@janestreet.com" authors: ["Jane Street Group, LLC "] homepage: "https://github.com/janestreet/ppx_let" bug-reports: "https://github.com/janestreet/ppx_let/issues" dev-repo: "git+https://github.com/janestreet/ppx_let.git" +doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_let/index.html" license: "MIT" build: [ - ["jbuilder" "build" "-p" name "-j" jobs] + ["dune" "build" "-p" name "-j" jobs] ] depends: [ + "ocaml" {>= "4.04.2"} "base" - "jbuilder" {build & >= "1.0+beta18.1"} - "ppxlib" {>= "0.1.0"} + "dune" {build & >= "1.5.1"} + "ppxlib" {>= "0.4.0"} ] -available: [ ocaml-version >= "4.04.2" ] -descr: " -Monadic let-bindings - +synopsis: "Monadic let-bindings" +description: " Part of the Jane Street's PPX rewriters collection. " diff --git a/src/dune b/src/dune new file mode 100644 index 000000000..ffbf7292a --- /dev/null +++ b/src/dune @@ -0,0 +1,2 @@ +(library (name ppx_let) (public_name ppx_let) (kind ppx_rewriter) + (libraries base ppxlib ppx_let_expander) (preprocess no_preprocessing)) \ No newline at end of file diff --git a/src/jbuild b/src/jbuild deleted file mode 100644 index 3c8e6e818..000000000 --- a/src/jbuild +++ /dev/null @@ -1,8 +0,0 @@ -(library ( - (name ppx_let) - (public_name ppx_let) - (kind ppx_rewriter) - (libraries (base ppxlib ppx_let_expander)) - (preprocess no_preprocessing))) - -(jbuild_version 1) diff --git a/src/ppx_let.ml b/src/ppx_let.ml index 5b821786a..3f9985502 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -10,11 +10,7 @@ let ext extension_name = ;; let () = - Driver.register_transformation "let" - ~extensions:[ - ext Bind; - ext Bind_open; - ext Map; - ext Map_open; - ] + Driver.register_transformation + "let" + ~extensions:[ ext Bind; ext Bind_open; ext Map; ext Map_open ] ;; diff --git a/src/ppx_let.mli b/src/ppx_let.mli index e69de29bb..8b1378917 100644 --- a/src/ppx_let.mli +++ b/src/ppx_let.mli @@ -0,0 +1 @@ + diff --git a/test/dune b/test/dune new file mode 100644 index 000000000..c53c7966b --- /dev/null +++ b/test/dune @@ -0,0 +1 @@ +(executables (names test) (preprocess (pps ppx_let))) \ No newline at end of file diff --git a/test/jbuild b/test/jbuild deleted file mode 100644 index 6bf70a34f..000000000 --- a/test/jbuild +++ /dev/null @@ -1,6 +0,0 @@ -(executables ( - (names (test)) - (preprocess (pps (ppx_let ppxlib.runner))))) - - -(jbuild_version 1) diff --git a/test/test-locations.mlt b/test/test-locations.mlt index 765b8b345..47a5009e1 100644 --- a/test/test-locations.mlt +++ b/test/test-locations.mlt @@ -2,17 +2,26 @@ module Let_syntax = struct type 'a t = T of 'a + let map (T x) ~f = T (f x) let both (T x) (T y) = T (x, y) + module Open_on_rhs = struct let return x = T x - let f x ~(doc:string) = T (x, doc) + let f x ~(doc : string) = T (x, doc) end end -let _ = [%map_open let x = return 42 and y = f 42 in ()] -[%%expect{| -Line _, characters 45-49: +let _ = + [%map_open + let x = return 42 + and y = f 42 in + ()] +;; + +[%%expect + {| +Line _, characters 12-16: Error: This expression has type doc:string -> (int * string) Let_syntax.t but an expression was expected of type 'a Let_syntax.t |}] diff --git a/test/test.ml b/test/test.ml index 0f035fa18..ac502de51 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1,31 +1,41 @@ 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 + 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) + 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 + let bind = bind + let map = map + let both = both + + module Open_on_rhs = struct + let return = return + end end end end @@ -35,50 +45,55 @@ module Monad_example = struct 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 + 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 + 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 + 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 + 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 @@ -87,15 +102,19 @@ module Applicative_example = struct end end = struct type 'a t = 'a + let return x = x let map x ~f = f x - let both x y = (x, y) + 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 + let map = map + let both = both + module Open_on_rhs = struct let flag = 66 let anon = 77 @@ -121,10 +140,14 @@ module Applicative_example = struct 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 + let%map x = a + and y = b + and u, v = c in x + y + (u * v) + ;; (* {[ let _ah a : _ X.t = @@ -137,10 +160,12 @@ module Applicative_example = struct 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 From a1281ff6770312e96c1b11a9289ffc207d8b43fc Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Fri, 18 Jan 2019 10:20:30 +0000 Subject: [PATCH 54/59] v0.12-preview.120.19+170 --- src/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune b/src/dune index ffbf7292a..a770da275 100644 --- a/src/dune +++ b/src/dune @@ -1,2 +1,2 @@ (library (name ppx_let) (public_name ppx_let) (kind ppx_rewriter) - (libraries base ppxlib ppx_let_expander) (preprocess no_preprocessing)) \ No newline at end of file + (libraries ppxlib ppx_let_expander) (preprocess no_preprocessing)) \ No newline at end of file From d77331bbdae4fdaf7383c7c12647dba6c1eba478 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Fri, 1 Feb 2019 10:07:38 +0000 Subject: [PATCH 55/59] v0.12-preview.120.21+190 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index 331f34e78..f6e188581 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -13,7 +13,7 @@ depends: [ "ocaml" {>= "4.04.2"} "base" "dune" {build & >= "1.5.1"} - "ppxlib" {>= "0.4.0"} + "ppxlib" {>= "0.5.0"} ] synopsis: "Monadic let-bindings" description: " From 2c1ecd97ed5ed63bfeb07545e6d3c5882c38c7d6 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Thu, 14 Mar 2019 09:55:45 +0000 Subject: [PATCH 56/59] v0.13-preview.120.27+112 --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 85f39e57b..6c14091bb 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ _build *.install *.merlin +_opam From 2df862bdbf5ecd152f8e026c004bed6cdd632434 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Tue, 16 Apr 2019 09:38:08 +0100 Subject: [PATCH 57/59] v0.13-preview.120.32+18 --- ppx_let.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ppx_let.opam b/ppx_let.opam index f6e188581..2de221630 100644 --- a/ppx_let.opam +++ b/ppx_let.opam @@ -10,7 +10,7 @@ build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ - "ocaml" {>= "4.04.2"} + "ocaml" {>= "4.04.2" & < "4.08.0"} "base" "dune" {build & >= "1.5.1"} "ppxlib" {>= "0.5.0"} From abe81261518513e62d395c214e3e568c447ea540 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Fri, 19 Apr 2019 11:59:32 +0200 Subject: [PATCH 58/59] Single point of configuration to add many let%foo directives --- expander/ppx_let_expander.ml | 61 ++++++++++++----------------------- expander/ppx_let_expander.mli | 12 +------ src/ppx_let.ml | 11 ++++--- test/test.ml | 18 +++++++++++ 4 files changed, 46 insertions(+), 56 deletions(-) diff --git a/expander/ppx_let_expander.ml b/expander/ppx_let_expander.ml index c6eabf695..9a41e63c4 100644 --- a/expander/ppx_let_expander.ml +++ b/expander/ppx_let_expander.ml @@ -12,34 +12,14 @@ module List = struct ;; 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 ~modul : Longident.t = match modul with | None -> Lident "Let_syntax" | Some id -> Ldot (id.txt, "Let_syntax") ;; -let open_on_rhs ~loc ~modul = - Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs")) +let open_on_rhs ~loc ~modul ~extension_name_s = + Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs_" ^ extension_name_s)) ;; let eoperator ~loc ~modul func = @@ -65,21 +45,20 @@ let expand_with_tmp_vars ~loc bindings expr ~f = pexp_let ~loc Nonrecursive s_lhs_tmp_var (f ~loc s_rhs_tmp_var expr) ;; -let bind_apply ~loc ~modul extension_name ~arg ~fn = +let bind_apply ~loc ~modul extension_name_s ~arg ~fn = pexp_apply ~loc - (eoperator ~loc ~modul (Extension_name.operator_name extension_name)) + (eoperator ~loc ~modul extension_name_s) [ Nolabel, arg; Labelled "f", fn ] ;; -let maybe_open extension_name ~to_open:module_to_open expr = +(* Change by Georges: Always open for all extension names. *) +let maybe_open ~to_open:module_to_open expr = let loc = expr.pexp_loc in - match (extension_name : Extension_name.t) with - | Bind | Map -> expr - | Bind_open | Map_open -> pexp_open ~loc Override (module_to_open ~loc) expr + pexp_open ~loc Override (module_to_open ~loc) expr ;; -let expand_let extension_name ~loc ~modul bindings body = +let expand_let extension_name_s ~loc ~modul bindings body = if List.is_empty bindings then invalid_arg "expand_let: list of bindings must be non-empty"; (* Build expression [both E1 (both E2 (both ...))] *) @@ -99,17 +78,17 @@ let expand_let extension_name ~loc ~modul bindings body = bind_apply ~loc ~modul - extension_name + extension_name_s ~arg:nested_boths ~fn:(pexp_fun ~loc Nolabel None nested_patterns body) ;; -let expand_match extension_name ~loc ~modul expr cases = +let expand_match extension_name_s ~loc ~modul expr cases = bind_apply ~loc ~modul - extension_name - ~arg:(maybe_open extension_name ~to_open:(open_on_rhs ~modul) expr) + extension_name_s + ~arg:(maybe_open ~to_open:(open_on_rhs ~modul ~extension_name_s) expr) ~fn:(pexp_function ~loc cases) ;; @@ -123,7 +102,7 @@ let expand_if extension_name ~loc expr then_ else_ = ] ;; -let expand ~modul extension_name expr = +let expand ~modul extension_name_s expr = let loc = expr.pexp_loc in let expansion = match expr.pexp_desc with @@ -145,16 +124,16 @@ let expand ~modul extension_name expr = { vb with pvb_pat ; pvb_expr = - maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr + maybe_open ~to_open:(open_on_rhs ~modul ~extension_name_s) vb.pvb_expr }) in - expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name ~modul) + expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name_s ~modul) | 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 ~modul expr cases + extension_name_s + | Pexp_match (expr, cases) -> expand_match extension_name_s ~loc ~modul expr cases | Pexp_ifthenelse (expr, then_, else_) -> let else_ = match else_ with @@ -163,14 +142,14 @@ let expand ~modul extension_name expr = Location.raise_errorf ~loc "'if%%%s' must include an else branch" - (Extension_name.to_string extension_name) + extension_name_s in - expand_if extension_name ~loc ~modul expr then_ else_ + expand_if extension_name_s ~loc ~modul expr then_ else_ | _ -> Location.raise_errorf ~loc "'%%%s' can only be used with 'let', 'match', and 'if'" - (Extension_name.to_string extension_name) + extension_name_s in { expansion with pexp_attributes = expr.pexp_attributes @ expansion.pexp_attributes } ;; diff --git a/expander/ppx_let_expander.mli b/expander/ppx_let_expander.mli index 71333f8a8..be89bf69d 100644 --- a/expander/ppx_let_expander.mli +++ b/expander/ppx_let_expander.mli @@ -1,13 +1,3 @@ open Ppxlib -module Extension_name : sig - type t = - | Bind - | Bind_open - | Map - | Map_open - - val to_string : t -> string -end - -val expand : modul:longident loc option -> Extension_name.t -> expression -> expression +val expand : modul:longident loc option -> string -> expression -> expression diff --git a/src/ppx_let.ml b/src/ppx_let.ml index 3f9985502..257c3bb09 100644 --- a/src/ppx_let.ml +++ b/src/ppx_let.ml @@ -1,16 +1,19 @@ open Ppxlib -let ext extension_name = +let ext extension_name_s = Extension.declare_with_path_arg - (Ppx_let_expander.Extension_name.to_string extension_name) + extension_name_s Extension.Context.expression Ast_pattern.(single_expr_payload __) (fun ~loc:_ ~path:_ ~arg expr -> - Ppx_let_expander.expand extension_name ~modul:arg expr) + Ppx_let_expander.expand extension_name_s ~modul:arg expr) ;; let () = Driver.register_transformation "let" - ~extensions:[ ext Bind; ext Bind_open; ext Map; ext Map_open ] + ~extensions:(List.map ext [ + "bind"; + "xxx"; + ]) ;; diff --git a/test/test.ml b/test/test.ml index ac502de51..d42d663b6 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1,3 +1,20 @@ +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 @@ -169,3 +186,4 @@ module Example_without_open = struct x + 1 ;; end +*) From 9942e5677d11d89bf58f82252835e282f298acf9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Fri, 19 Apr 2019 12:25:24 +0200 Subject: [PATCH 59/59] Moved all ppx_let files from third-party git repository to src/ppx_let --- .gitignore => src/ppx_let/.gitignore | 0 CHANGES.md => src/ppx_let/CHANGES.md | 0 CONTRIBUTING.md => src/ppx_let/CONTRIBUTING.md | 0 src/ppx_let/CREDITS | 4 ++++ LICENSE.md => src/ppx_let/LICENSE.md | 0 Makefile => src/ppx_let/Makefile | 0 README.md => src/ppx_let/README.md | 0 dune => src/ppx_let/dune | 0 dune-project => src/ppx_let/dune-project | 0 {expander => src/ppx_let/expander}/dune | 0 {expander => src/ppx_let/expander}/ppx_let_expander.ml | 0 {expander => src/ppx_let/expander}/ppx_let_expander.mli | 0 ppx_let.opam => src/ppx_let/ppx_let.opam | 0 src/{ => ppx_let/src}/dune | 0 src/{ => ppx_let/src}/ppx_let.ml | 0 src/{ => ppx_let/src}/ppx_let.mli | 0 {test => src/ppx_let/test}/dune | 0 {test => src/ppx_let/test}/test-locations.mlt | 0 {test => src/ppx_let/test}/test.ml | 0 19 files changed, 4 insertions(+) rename .gitignore => src/ppx_let/.gitignore (100%) rename CHANGES.md => src/ppx_let/CHANGES.md (100%) rename CONTRIBUTING.md => src/ppx_let/CONTRIBUTING.md (100%) create mode 100644 src/ppx_let/CREDITS rename LICENSE.md => src/ppx_let/LICENSE.md (100%) rename Makefile => src/ppx_let/Makefile (100%) rename README.md => src/ppx_let/README.md (100%) rename dune => src/ppx_let/dune (100%) rename dune-project => src/ppx_let/dune-project (100%) rename {expander => src/ppx_let/expander}/dune (100%) rename {expander => src/ppx_let/expander}/ppx_let_expander.ml (100%) rename {expander => src/ppx_let/expander}/ppx_let_expander.mli (100%) rename ppx_let.opam => src/ppx_let/ppx_let.opam (100%) rename src/{ => ppx_let/src}/dune (100%) rename src/{ => ppx_let/src}/ppx_let.ml (100%) rename src/{ => ppx_let/src}/ppx_let.mli (100%) rename {test => src/ppx_let/test}/dune (100%) rename {test => src/ppx_let/test}/test-locations.mlt (100%) rename {test => src/ppx_let/test}/test.ml (100%) diff --git a/.gitignore b/src/ppx_let/.gitignore similarity index 100% rename from .gitignore rename to src/ppx_let/.gitignore diff --git a/CHANGES.md b/src/ppx_let/CHANGES.md similarity index 100% rename from CHANGES.md rename to src/ppx_let/CHANGES.md diff --git a/CONTRIBUTING.md b/src/ppx_let/CONTRIBUTING.md similarity index 100% rename from CONTRIBUTING.md rename to src/ppx_let/CONTRIBUTING.md diff --git a/src/ppx_let/CREDITS b/src/ppx_let/CREDITS new file mode 100644 index 000000000..6a3ab4f2a --- /dev/null +++ b/src/ppx_let/CREDITS @@ -0,0 +1,4 @@ +This folder contains a generalization of ppx_let from Jane Street. +See git log this_folder for the development history. + +https://github.com/janestreet/ppx_let.git diff --git a/LICENSE.md b/src/ppx_let/LICENSE.md similarity index 100% rename from LICENSE.md rename to src/ppx_let/LICENSE.md diff --git a/Makefile b/src/ppx_let/Makefile similarity index 100% rename from Makefile rename to src/ppx_let/Makefile diff --git a/README.md b/src/ppx_let/README.md similarity index 100% rename from README.md rename to src/ppx_let/README.md diff --git a/dune b/src/ppx_let/dune similarity index 100% rename from dune rename to src/ppx_let/dune diff --git a/dune-project b/src/ppx_let/dune-project similarity index 100% rename from dune-project rename to src/ppx_let/dune-project diff --git a/expander/dune b/src/ppx_let/expander/dune similarity index 100% rename from expander/dune rename to src/ppx_let/expander/dune diff --git a/expander/ppx_let_expander.ml b/src/ppx_let/expander/ppx_let_expander.ml similarity index 100% rename from expander/ppx_let_expander.ml rename to src/ppx_let/expander/ppx_let_expander.ml diff --git a/expander/ppx_let_expander.mli b/src/ppx_let/expander/ppx_let_expander.mli similarity index 100% rename from expander/ppx_let_expander.mli rename to src/ppx_let/expander/ppx_let_expander.mli diff --git a/ppx_let.opam b/src/ppx_let/ppx_let.opam similarity index 100% rename from ppx_let.opam rename to src/ppx_let/ppx_let.opam diff --git a/src/dune b/src/ppx_let/src/dune similarity index 100% rename from src/dune rename to src/ppx_let/src/dune diff --git a/src/ppx_let.ml b/src/ppx_let/src/ppx_let.ml similarity index 100% rename from src/ppx_let.ml rename to src/ppx_let/src/ppx_let.ml diff --git a/src/ppx_let.mli b/src/ppx_let/src/ppx_let.mli similarity index 100% rename from src/ppx_let.mli rename to src/ppx_let/src/ppx_let.mli diff --git a/test/dune b/src/ppx_let/test/dune similarity index 100% rename from test/dune rename to src/ppx_let/test/dune diff --git a/test/test-locations.mlt b/src/ppx_let/test/test-locations.mlt similarity index 100% rename from test/test-locations.mlt rename to src/ppx_let/test/test-locations.mlt diff --git a/test/test.ml b/src/ppx_let/test/test.ml similarity index 100% rename from test/test.ml rename to src/ppx_let/test/test.ml