v0.18~preview.130.05+548

.gitignore

@@ -0,0 +1,5 @@
+_build
+*.install
+*.merlin
+_opam
+

.ocamlformat

@@ -0,0 +1 @@
+profile=janestreet

CHANGES.md

@@ -0,0 +1 @@
+* Initial release.

CONTRIBUTING.md

@@ -0,0 +1,67 @@
+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 <[email protected]>
+```
+
+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/
+[js]: https://opensource.janestreet.com/

LICENSE.md

@@ -0,0 +1,21 @@
+The MIT License
+
+Copyright (c) 2024 Jane Street Group, LLC <[email protected]>
+
+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.

Makefile

@@ -0,0 +1,17 @@
+INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
+
+default:
+	dune build
+
+install:
+	dune install $(INSTALL_ARGS)
+
+uninstall:
+	dune uninstall $(INSTALL_ARGS)
+
+reinstall: uninstall install
+
+clean:
+	dune clean
+
+.PHONY: default install uninstall reinstall clean

dune-project

@@ -0,0 +1 @@
+(lang dune 3.11)

ppx_shorthand.opam

@@ -0,0 +1,22 @@
+opam-version: "2.0"
+maintainer: "Jane Street developers"
+authors: ["Jane Street Group, LLC"]
+homepage: "https://github.com/janestreet/ppx_shorthand"
+bug-reports: "https://github.com/janestreet/ppx_shorthand/issues"
+dev-repo: "git+https://github.com/janestreet/ppx_shorthand.git"
+doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_shorthand/index.html"
+license: "MIT"
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+]
+depends: [
+  "ocaml" {>= "5.1.0"}
+  "base"
+  "dune"   {>= "3.11.0"}
+  "ppxlib" {>= "0.33.0"}
+]
+available: arch != "arm32" & arch != "x86_32"
+synopsis: "A grab-bag of small but useful AST transformations"
+description: "
+This ppx is a collection of small AST transformations that might not otherwise warrant their own ppx.
+"

src/dune

@@ -0,0 +1,7 @@
+(library
+ (name ppx_shorthand)
+ (public_name ppx_shorthand)
+ (kind ppx_rewriter)
+ (libraries base base.composition_infix ppxlib)
+ (preprocess
+  (pps ppxlib.metaquot)))

src/eta.ml

@@ -0,0 +1,66 @@
+open! Base
+open! Import
+
+type arrow =
+  { args : (arg_label * core_type) list
+  ; ret : core_type
+  ; is_local_return : bool
+  }
+
+let cons_args ret =
+  let open Ast_pattern in
+  map3 (ptyp_arrow __ __ ret) ~f:(fun label typ args -> (label, typ) :: args)
+;;
+
+let is_local_return (_ : core_type) = false
+
+let arrow_pattern =
+  let open Ast_pattern in
+  map3
+    (as__ (cons_args (fix (fun ret -> cons_args ret ||| map0 __ ~f:[]))))
+    ~f:(fun typ args ret -> { args; ret; is_local_return = is_local_return typ })
+;;
+
+let eta_pattern =
+  let open Ast_pattern in
+  single_expr_payload (pexp_constraint __ arrow_pattern)
+;;
+
+let arg_name i = function
+  | Nolabel -> Printf.sprintf "__eta_%d" i
+  | Labelled label | Optional label -> label
+;;
+
+let expand ~loc f { args; ret; is_local_return } =
+  let loc = ghostify#location loc in
+  let arg_pats =
+    List.mapi args ~f:(fun i (label, _) ->
+      label, Ast_builder.pvar ~loc (arg_name i label))
+  in
+  let arg_exprs =
+    List.mapi args ~f:(fun i (label, arg) ->
+      let arg =
+        match label with
+        | Nolabel | Labelled _ -> arg
+        | Optional _ -> [%type: [%t arg] Stdlib.Option.t]
+      in
+      label, [%expr ([%e Ast_builder.evar ~loc (arg_name i label)] : [%t arg])])
+  in
+  let body = { (Ast_builder.pexp_apply ~loc f arg_exprs) with pexp_loc = loc } in
+  let ret_expr = [%expr ([%e body] : [%t ret])] in
+  let ret_expr = if is_local_return then [%expr [%e ret_expr]] else ret_expr in
+  List.fold_right
+    arg_pats
+    ~f:(fun (label, pat) -> Ast_builder.pexp_fun ~loc label None pat)
+    ~init:ret_expr
+;;
+
+let eta_extension =
+  Extension.declare
+    "eta"
+    Extension.Context.expression
+    eta_pattern
+    (fun ~loc ~path:(_ : string) expr arrow -> expand ~loc expr arrow)
+;;
+
+let extensions = [ eta_extension ]

src/eta.mli

@@ -0,0 +1,3 @@
+open! Base
+
+val extensions : Ppxlib.Extension.t list

src/import.ml

@@ -0,0 +1,30 @@
+include struct
+  open Ppxlib
+  include Ast
+  module Ast_builder = Ast_builder.Default
+
+  module Ast_pattern = struct
+    include Ast_pattern
+
+    let map3 t ~f = map t ~f:(fun k a b c -> k (f a b c))
+
+    (* [fix f] computes the fixpoint of [f]. *)
+    let fix f =
+      let rec t ctx loc x k = (to_func (f (of_func t))) ctx loc x k in
+      f (of_func t)
+    ;;
+  end
+
+  module Attribute = Attribute
+  module Extension = Extension
+  module Location = Location
+end
+
+let ghostify =
+  object
+    inherit Ppxlib.Ast_traverse.map
+    method! location loc = { loc with loc_ghost = true }
+  end
+;;
+
+include Composition_infix

src/ppx_shorthand.ml

@@ -0,0 +1,7 @@
+open! Base
+
+let () =
+  Ppxlib.Driver.register_transformation
+    "shorthand"
+    ~extensions:(List.concat [ Rederive.extensions; Eta.extensions ])
+;;

src/ppx_shorthand.mli

@@ -0,0 +1 @@
+(*_ This file is intentionally blank. *)