pax_global_header00006660000000000000000000000064142027330520014510gustar00rootroot0000000000000052 comment=40be3ab4fdacf424db365198a461ee7ffedff84a ppx_optional-0.15.0/000077500000000000000000000000001420273305200143075ustar00rootroot00000000000000ppx_optional-0.15.0/.gitignore000066400000000000000000000000411420273305200162720ustar00rootroot00000000000000_build *.install *.merlin _opam ppx_optional-0.15.0/CHANGES.md000066400000000000000000000001451420273305200157010ustar00rootroot00000000000000## v0.11 - Depend on ppxlib instead of (now deprecated) ppx\_core, ppx\_driver and ppx\_metaquot. ppx_optional-0.15.0/CONTRIBUTING.md000066400000000000000000000044101420273305200165370ustar00rootroot00000000000000This 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/ [js]: https://opensource.janestreet.com/ ppx_optional-0.15.0/LICENSE.md000066400000000000000000000021351420273305200157140ustar00rootroot00000000000000The MIT License Copyright (c) 2016--2022 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. ppx_optional-0.15.0/Makefile000066400000000000000000000004031420273305200157440ustar00rootroot00000000000000INSTALL_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 ppx_optional-0.15.0/README.md000066400000000000000000000015511420273305200155700ustar00rootroot00000000000000ppx_optional - match statements for zero-alloc options ====================================================== A ppx rewriter that rewrites simple match statements with an if then else expression. Syntax ------ `ppx_optional` rewrites the extension `match%optional` in expressions. It requires that a module `Optional_syntax` is in scope, and that it has `is_none` and `unsafe_value` values. For instance: ```ocaml match%optional e with | None -> none_expression | Some x -> some_expression ``` becomes: ```ocaml if Optional_syntax.is_none e then begin none_expression end else begin let x = Optional_syntax.unsafe_value e in some_expression end ``` Usage ----- This is normally used to safely access an optional value while avoiding allocation for immediate values (e.g. `Immediate.{Char,Bool,Int}.Option`, `Fixed.Option`, `Price.Fixed.Option`, etc...). ppx_optional-0.15.0/dune000066400000000000000000000000001420273305200151530ustar00rootroot00000000000000ppx_optional-0.15.0/dune-project000066400000000000000000000000201420273305200166210ustar00rootroot00000000000000(lang dune 1.10)ppx_optional-0.15.0/ppx_optional.opam000066400000000000000000000013111420273305200176750ustar00rootroot00000000000000opam-version: "2.0" version: "v0.15.0" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/ppx_optional" bug-reports: "https://github.com/janestreet/ppx_optional/issues" dev-repo: "git+https://github.com/janestreet/ppx_optional.git" doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_optional/index.html" license: "MIT" build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "ocaml" {>= "4.08.0"} "base" {>= "v0.15" & < "v0.16"} "dune" {>= "2.0.0"} "ppxlib" {>= "0.23.0"} ] synopsis: "Pattern matching on flat options" description: " A ppx rewriter that rewrites simple match statements with an if then else expression. " ppx_optional-0.15.0/src/000077500000000000000000000000001420273305200150765ustar00rootroot00000000000000ppx_optional-0.15.0/src/dune000066400000000000000000000002101420273305200157450ustar00rootroot00000000000000(library (name ppx_optional) (public_name ppx_optional) (kind ppx_rewriter) (libraries base ppxlib) (preprocess (pps ppxlib.metaquot)))ppx_optional-0.15.0/src/ppx_optional.ml000066400000000000000000000213131420273305200201440ustar00rootroot00000000000000open Base open Ppxlib open Ast_builder.Default (* The scope in which to find [Optional_syntax]. [From_module] means using module.Optional_syntax.Optional_syntax *) type module_scope = | Use_optional_syntax | Use_optional_syntax_optional_syntax | From_module of longident loc module Matched_expression_element = struct type t = { module_ : module_scope ; exp : expression } end type t = { default_module : module_scope ; original_matched_expr : expression ; elements : Matched_expression_element.t list ; match_loc : Location.t ; cases : case list } let module_scope_of_option = function | None -> Use_optional_syntax | Some module_ -> From_module module_ ;; let infer_module_from_core_type ~module_ (core_type : core_type) = let default = module_scope_of_option module_ in match core_type.ptyp_desc with | Ptyp_constr (longident, _params) -> (match longident.txt with | Lident _ -> Use_optional_syntax_optional_syntax | Ldot (longident, _label) -> From_module { txt = longident; loc = core_type.ptyp_loc } | Lapply _ -> default) | _ -> default ;; let expand_matched_expr ~(module_ : longident loc option) matched_expr = let individual_exprs = match matched_expr.pexp_desc with | Pexp_tuple exprs -> exprs | _ -> [ matched_expr ] in List.map individual_exprs ~f:(fun exp -> match exp.pexp_desc with | Pexp_constraint (_exp, core_type) -> { Matched_expression_element.module_ = infer_module_from_core_type ~module_ core_type ; exp } | _ -> { module_ = module_scope_of_option module_; exp }) ;; let optional_syntax_str = "Optional_syntax" let optional_syntax ~module_ : Longident.t = match (module_ : module_scope) with | Use_optional_syntax -> Lident optional_syntax_str | Use_optional_syntax_optional_syntax -> Ldot (Lident optional_syntax_str, optional_syntax_str) | From_module id -> Ldot (Ldot (id.txt, optional_syntax_str), optional_syntax_str) ;; let eoperator ~loc ~module_ func = let lid : Longident.t = Ldot (optional_syntax ~module_, func) in pexp_ident ~loc (Located.mk ~loc lid) ;; let eunsafe_value = eoperator "unsafe_value" let eis_none = eoperator "is_none" let rec assert_binder pat = match pat.ppat_desc with | Ppat_constraint (pat, _) -> (* Allow "Some (_ : typ)" *) assert_binder pat | Ppat_var _ | Ppat_any -> () | _ -> Location.raise_errorf ~loc:pat.ppat_loc "sub patterns are restricted to variable names and wildcards" ;; let disable_all_warnings e = let attr = let loc = Location.none in attribute ~loc ~name:{ Location.loc; txt = "ocaml.warning" } ~payload:(PStr [ pstr_eval ~loc (estring ~loc "-a") [] ]) in { e with pexp_attributes = attr :: e.pexp_attributes } ;; let varname i = Printf.sprintf "__ppx_optional_e_%i" i let evar ~loc i = evar ~loc (varname i) let pvar ~loc i = pvar ~loc (varname i) let get_pattern_and_binding ~module_ i pattern = let loc = pattern.ppat_loc in let pat, binding_opt = match pattern with | [%pat? Some [%p? x]] -> assert_binder x; let binding = value_binding ~loc ~pat:[%pat? ([%p x] : _)] ~expr:(eapply ~loc (eunsafe_value ~loc ~module_) [ evar ~loc i ]) in [%pat? false], Some binding | [%pat? None] -> [%pat? true], None | [%pat? _] -> pattern, None | _ -> Location.raise_errorf ~loc:pattern.ppat_loc "only None, Some and _ are supported in [%%optional ]" in (* by only using the ppat_desc from the pattern we just generated we ensure that the location of the original pattern is kept. *) { pattern with ppat_desc = pat.ppat_desc }, binding_opt ;; let rewrite_case ~match_loc ~modules ~default_module { pc_lhs = pat; pc_rhs = body; pc_guard } = let modules_array = Array.of_list modules in let get_module i = (* Sadly, we need to be able to handle the case when the length of the matched expression doesn't equal the length of the case, in order to produce useful error messages (with the proper types). *) if i < Array.length modules_array then modules_array.(i) else default_module in let ppat_desc, bindings = match pat.ppat_desc with | Ppat_tuple patts -> let patts, binding_opts = List.mapi patts ~f:(fun i patt -> let module_ = get_module i in get_pattern_and_binding ~module_ i patt) |> List.unzip in Ppat_tuple patts, List.filter_map binding_opts ~f:Fn.id | _ -> let pat, binding_opt = get_pattern_and_binding 0 pat ~module_:(List.hd_exn modules) in pat.ppat_desc, Option.to_list binding_opt in let pc_lhs = { pat with ppat_desc } in let pc_rhs, pc_guard = match bindings with | [] -> body, pc_guard | _ -> ( pexp_let ~loc:match_loc Nonrecursive bindings body , Option.map pc_guard ~f:(fun pc_guard -> pexp_let ~loc:pc_guard.pexp_loc Nonrecursive bindings pc_guard) ) in { pc_lhs; pc_rhs; pc_guard } ;; (** Take the matched expression and replace all its components by a variable, which will have been bound previously, wrapped by [wrapper]. We do keep the location of the initial component for the new one. *) let rewrite_matched_expr t ~wrapper = let subst_and_wrap i { Matched_expression_element.module_; exp } = let loc = { exp.pexp_loc with loc_ghost = true } in wrapper ~module_ (evar ~loc i) in let pexp_desc = match t.elements with | [ singleton ] -> (subst_and_wrap 0 singleton).pexp_desc | list -> Pexp_tuple (List.mapi list ~f:subst_and_wrap) in let pexp_loc = { t.original_matched_expr.pexp_loc with loc_ghost = true } in { t.original_matched_expr with pexp_desc; pexp_loc } ;; let real_match t = let new_matched_expr = rewrite_matched_expr t ~wrapper:(fun ~module_ expr -> let loc = expr.pexp_loc in eapply ~loc (eis_none ~loc ~module_) [ expr ]) in let modules = List.map t.elements ~f:(fun { module_; _ } -> module_) in let cases = List.map t.cases ~f:(rewrite_case ~match_loc:t.match_loc ~modules ~default_module:t.default_module) in (* we can disable the warning here as we rely on the other match we generate for error messages. *) disable_all_warnings (pexp_match ~loc:t.match_loc new_matched_expr cases) ;; let fake_match t = let new_matched_expr = rewrite_matched_expr t ~wrapper:(fun ~module_ expr -> let loc = expr.pexp_loc in [%expr (* This code will never be executed, it is just here so the type checker generates nice error messages. *) if [%e eis_none ~loc ~module_] [%e expr] then None else Some ([%e eunsafe_value ~loc ~module_] [%e expr])]) in pexp_match ~loc:{ t.match_loc with loc_ghost = true } new_matched_expr t.cases ;; let bindings_for_matched_expr matched_expr = let bind i expr = let loc = { expr.pexp_loc with loc_ghost = true } in value_binding ~loc ~pat:(pvar ~loc i) ~expr in List.mapi matched_expr ~f:(fun i { Matched_expression_element.exp; _ } -> bind i exp) ;; let expand_match ~match_loc ~(module_ : longident loc option) matched_expr cases = let t = { default_module = module_scope_of_option module_ ; original_matched_expr = matched_expr ; elements = expand_matched_expr ~module_ matched_expr ; match_loc ; cases } in let fake_match = (* The types in this branch actually match what the user would expect given the source code, so we tell merlin to do all its work in here. *) Merlin_helpers.focus_expression (fake_match t) in let real_match = (* The types here actually have nothing to do with what's in the source ([bool] appears for example), so we tell merlin to avoid that branch. *) Merlin_helpers.hide_expression (real_match t) in let bindings = bindings_for_matched_expr t.elements in let loc = { match_loc with loc_ghost = true } in pexp_let ~loc Nonrecursive bindings (pexp_ifthenelse ~loc (ebool ~loc false) fake_match (Some real_match)) ;; (* We add the indirection instead of directly matching on [pexp_match] when declaring the extension because we want more informative error messages than "Extension was not translated". *) let expand_match ~loc ~path:_ ~arg:(module_ : longident loc option) e = Ast_pattern.parse Ast_pattern.(pexp_match __ __) loc e ~on_error:(fun () -> Location.raise_errorf ~loc "[%%optional ] must apply to a match statement") (expand_match ~match_loc:e.pexp_loc ~module_) ;; let optional = Extension.declare_with_path_arg "optional" Extension.Context.expression Ast_pattern.(single_expr_payload __) expand_match ;; let () = Driver.register_transformation "optional" ~extensions:[ optional ] ppx_optional-0.15.0/src/ppx_optional.mli000066400000000000000000000000001420273305200203030ustar00rootroot00000000000000