pax_global_header00006660000000000000000000000064142521073310014510gustar00rootroot0000000000000052 comment=bba10ee113166982fda75687f31439d63271b560 ppx_import-1.10.0/000077500000000000000000000000001425210733100137705ustar00rootroot00000000000000ppx_import-1.10.0/.github/000077500000000000000000000000001425210733100153305ustar00rootroot00000000000000ppx_import-1.10.0/.github/workflows/000077500000000000000000000000001425210733100173655ustar00rootroot00000000000000ppx_import-1.10.0/.github/workflows/build-and-test.yml000066400000000000000000000022331425210733100227240ustar00rootroot00000000000000name: Build and Test on: push: branches: [ master ] pull_request: branches: [ master ] jobs: build: strategy: fail-fast: false matrix: os: - ubuntu-latest # - macos-latest # - windows-latest ocaml-compiler: - 4.05.x - 4.06.x - 4.07.x - 4.08.x - 4.09.x - 4.10.x - 4.11.x - 4.12.x - 4.13.x - 4.14.x runs-on: ${{ matrix.os }} steps: - name: Checkout code uses: actions/checkout@v2 - name: Use OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} dune-cache: ${{ matrix.os != 'macos-latest' }} opam-repositories: | default: https://github.com/ocaml/opam-repository.git beta: https://github.com/ocaml/ocaml-beta-repository.git - name: Install opam packages run: opam install . --deps-only --yes --with-test - name: Run build run: opam exec -- make build - name: Run tests run: opam exec -- make test ppx_import-1.10.0/.gitignore000066400000000000000000000000421425210733100157540ustar00rootroot00000000000000*~ _build *.install .merlin _opam ppx_import-1.10.0/.ocamlformat000066400000000000000000000002701425210733100162740ustar00rootroot00000000000000version=0.20.1 profile=ocamlformat module-item-spacing=compact sequence-style=terminator cases-exp-indent=2 field-space=loose exp-grouping=preserve break-cases=fit doc-comments=before ppx_import-1.10.0/.ocamlformat-ignore000066400000000000000000000000061425210733100175520ustar00rootroot00000000000000_opam ppx_import-1.10.0/CHANGES.md000066400000000000000000000042351425210733100153660ustar00rootroot000000000000001.10.0 ------ * Update ppxlib to 0.26.0 (#69, @pitag-ha) 1.9.1 ----- * Support for OCaml 4.14 (#67 kit-ty-kate) * ppx_import is not compatible with ppxlib >= 0.26 (#71 ejgallego) 1.9.0 ----- * Migrate to ppxlib #54 , closes #44 (tatchi) * Drop support for OCaml `4.04.2`. Minimal supported version is now `4.05.0` #54 (tatchi) * Bump minimum dune version to 1.11 #56 (tatchi) * Update CI to test OCaml 4.12.0, no changes required (#53, Emilio J. Gallego Arias) * Remove the OCaml upper bound in the opam file (#53, Emilio J. Gallego Arias, kit-ty-kate) 1.8.0 ----- * Upgrade the internal AST from 4.07 to 4.11 #52 (Gabriel Scherer, review by Emilio J. Gallego Arias) * Update lower bound for `ppx_tools_versioned` and `ocaml-migrate-parsetree` to 4.11 capable versions (Emilio J. Gallego Arias) 1.7.2 ----- * Remove a warning in OCaml 4.11 #49 (Kate Deplaix) 1.7.1 ----- * Support for OCaml 4.10 #47 (Emilio J. Gallego Arias) 1.7.0 ----- * OCaml 4.08 and 4.09 support #46 (Etienne Millon) 1.6.2 ----- * Fix import of module types with optional arguments (Thierry Martinez #37, review by whitequark) 1.6.1 ----- * Fix import of signatures with mutually recursive types (Thierry Martinez #35, review and tweaks by Gabriel Scherer) 1.6 --- * ocaml-migrate-parsetree + dune support #26 (Jérémie Dimino & Emilio Jesús Gallego Arias) * Move to OPAM 2.0, adapt Travis CI. (Emilio Jesús Gallego Arias) 1.5 --- * OCaml 4.07 support #24 (Damien Doligez) * Call the type-checker (through compiler-libs) instead of reading `.cmi` files directly, to correctly resolve module aliases. #25 (Gabriel Scherer) 1.4 --- * OCaml 4.06 support #19 (Gabriel Scherer) 1.3 --- * Also allow extraction of module types from the current module's interface file. #12 (Xavier Guérin) 1.2 --- * Allow extracting types from the current module's interface file. (Xavier Guérin) 1.1 --- * OCaml 4.03 support. (whitequark) 1.0 --- * Allow extracting types from module types. (whitequark) 0.1 --- * Initial release. (whitequark) ppx_import-1.10.0/LICENSE.md000066400000000000000000000020731425210733100153760ustar00rootroot00000000000000Copyright (c) 2014 Peter Zotov 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_import-1.10.0/Makefile000066400000000000000000000001741425210733100154320ustar00rootroot00000000000000build: dune build test: dune runtest clean: dune clean fmt: dune build @fmt --auto-promote .PHONY: build test clean ppx_import-1.10.0/README.dev.md000066400000000000000000000031211425210733100160210ustar00rootroot00000000000000Welcome to ppx_import, and thanks for willing to contribute to its development. ## How to release a new version of ppx_import **Quick release instructions:** Run `git tag -a` + `dune-release`. The preferred workflow to release `ppx_import` is to use `dune-release`. The first (and most important) step is to tag the release and push it to the main repository. We recommend you do this manually. As `dune-release` uses `git describe` to gather versioning information, your tag must be annotated. Using `git tag -a` or `git tag -s` will do the job. Please add the version changes to the tag annotation message. You can also use `dune-release tag`, which will try to infer the tag information from `CHANGES.md`, however the current heuristics seem too fragile and the changes list may not be properly updated. Once the tag is in place, calling `dune-release` will build, lint, run the tests, create the opam package, upload the archives and docs to the release page, and submit a pull request to the OPAM repository. Under the hood, `dune-release` executes the following 4 commands: ``` dune-release distrib # Create the distribution archive dune-release publish # Publish it on the WWW with its documentation dune-release opam pkg # Create an opam package dune-release opam submit # Submit it to OCaml's opam repository ``` It is often useful to run the commands separately as to have better control of the release process. Note that you will need the proper permissions for the `publish` step, including setting a Github access token, see `dune-release help files` for more information. ppx_import-1.10.0/README.md000066400000000000000000000054311425210733100152520ustar00rootroot00000000000000[%%import] ========== _import_ is a syntax extension that allows to pull in types or signatures from other compiled interface files. Sponsored by [Evil Martians](http://evilmartians.com). Installation ------------ _import_ can be installed via [OPAM](https://opam.ocaml.org): $ opam install ppx_import Usage ----- In order to use _import_, require the package `ppx_import`. #### Using `ppx_import` from Dune To use `ppx_import` from Dune you should use the [`staged_pps`](https://dune.readthedocs.io/en/latest/dune-files.html#preprocessing-specification) field to declare the preprocessing specification. Example: ``` (library (name foo) (preprocess (staged_pps ppx_import ppx_deriving.show)) ``` Syntax ------ ### Single declarations For example: ``` ocaml # type loc = [%import: Location.t];; type loc = Location.t = { loc_start : Lexing.position; loc_end : Lexing.position; loc_ghost : bool; } # module type Hashable = [%import: (module Hashtbl.HashedType)];; module type Hashable = sig type t val equal : t -> t -> bool val hash : t -> int end ``` It is also possible to import items from your own .mli file. ### Combining with [@@deriving] It's possible to combine _import_ and [_deriving_][deriving] to derive functions for types that you do not own, e.g.: [deriving]: https://github.com/whitequark/ppx_deriving ``` ocaml type longident = [%import: Longident.t] [@@deriving show] let () = print_endline (show_longident (Longident.parse "Foo.Bar.baz")) (* Longident.Ldot (Longident.Ldot (Longident.Lident ("Foo"), "Bar"), "baz") *) ``` Note that you need to require _import_ before any _deriving_ plugins, as otherwise _deriving_ will not be able to observe the complete type. ### [@with] replacements It is possible to syntactically replace a type with another while importing a definition. This can be used to import only a few types from a group, or to attach attributes to selected referenced types. For example, this snippet imports a single type from Parsetree and specifies a custom pretty-printer for _deriving show_. ``` ocaml type package_type = [%import: Parsetree.package_type [@with core_type := Parsetree.core_type [@printer Pprintast.core_type]; Asttypes.loc := Asttypes.loc [@polyprinter fun pp fmt x -> pp fmt x.Asttypes.txt]; Longident.t := Longident.t [@printer pp_longident]]] [@@deriving show] ``` For module types, the replacements are specified using the standard `with` construct. However, the replacement is still syntactic. ### More? If you have a use case in mind that _ppx_import_ does not cover (in particular, object-oriented features are not implemented), please [open an issue](https://github.com/ocaml-ppx/ppx_import/issues/new). License ------- _import_ is distributed under the terms of [MIT license](LICENSE.md). ppx_import-1.10.0/dune-project000066400000000000000000000000631425210733100163110ustar00rootroot00000000000000(lang dune 1.11) (using fmt 1.2) (name ppx_import) ppx_import-1.10.0/ppx_import.opam000066400000000000000000000024051425210733100170500ustar00rootroot00000000000000opam-version: "2.0" synopsis: "A syntax extension for importing declarations from interface files" name: "ppx_import" maintainer: "whitequark " authors: [ "whitequark " ] homepage: "https://github.com/ocaml-ppx/ppx_import" doc: "https://ocaml-ppx.github.io/ppx_import/" license: "MIT" bug-reports: "https://github.com/ocaml-ppx/ppx_import/issues" dev-repo: "git+https://github.com/ocaml-ppx/ppx_import.git" tags: [ "syntax" ] depends: [ ( "ocaml" {>= "4.05.0" & < "4.10.0" } "dune" { >= "1.11.0" } "ppxlib" { >= "0.26.0" } "ounit" { with-test } "ppx_deriving" { with-test & >= "4.2.1" } ) | ( "ocaml" { >= "4.10.0" } "ppx_sexp_conv" { with-test & >= "v0.13.0" } "dune" { >= "1.11.0" } "ppxlib" { >= "0.26.0" } "ounit" { with-test } "ppx_deriving" { with-test & >= "4.2.1" } ) ] build: [["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] { with-test } ] ppx_import-1.10.0/src/000077500000000000000000000000001425210733100145575ustar00rootroot00000000000000ppx_import-1.10.0/src/compat/000077500000000000000000000000001425210733100160425ustar00rootroot00000000000000ppx_import-1.10.0/src/compat/dune000066400000000000000000000000501425210733100167130ustar00rootroot00000000000000(executable (name gen) (modules gen)) ppx_import-1.10.0/src/compat/env_lookup_ge_000.ml000066400000000000000000000003261425210733100216100ustar00rootroot00000000000000let lookup_module ~loc:_ lid env = Env.lookup_module ~load:true lid env let find_type env ~loc head_id = Typetexp.find_type env loc head_id let find_modtype env ~loc head_id = Typetexp.find_modtype env loc head_id ppx_import-1.10.0/src/compat/env_lookup_ge_410.ml000066400000000000000000000003241425210733100216130ustar00rootroot00000000000000let lookup_module ~loc lid env = Env.lookup_module ~loc lid env |> fst let find_type env ~loc head_id = Env.lookup_type ~loc head_id env let find_modtype env ~loc:_ head_id = Env.find_modtype_by_name head_id env ppx_import-1.10.0/src/compat/gen.ml000066400000000000000000000021141425210733100171430ustar00rootroot00000000000000let include_ path = let ic = open_in path in let size = in_channel_length ic in let s = really_input_string ic size in print_endline s; close_in ic let make_version ~version f_prefix = let major, minor = version in let file = Format.asprintf "%s_ge_%1d%02d.ml" f_prefix major minor in Filename.concat "compat" file (* List of versions that need special treatment, check is greater or equal than. Order is important! *) let include_table = [ ("types_module_type", [(4, 10); (4, 8)]) ; ("types_signature_item", [(4, 8)]) ; ("types_type_kind", [(4, 13)]) ; ("init_path", [(4, 9)]) ; ("env_lookup", [(4, 10)]) ; ("types_desc", [(4, 14)]) ] let rec gen_compat real_version (f_prefix, version_list) = match version_list with | [] -> include_ (make_version ~version:(0, 0) f_prefix) | version :: vlist -> if real_version >= version then include_ (make_version ~version f_prefix) else gen_compat real_version (f_prefix, vlist) let () = let version = Scanf.sscanf Sys.ocaml_version "%d.%d" (fun a b -> (a, b)) in List.iter (gen_compat version) include_table ppx_import-1.10.0/src/compat/init_path_ge_000.ml000066400000000000000000000000541425210733100214040ustar00rootroot00000000000000let init_path () = Compmisc.init_path false ppx_import-1.10.0/src/compat/init_path_ge_409.ml000066400000000000000000000000511425210733100214160ustar00rootroot00000000000000let init_path () = Compmisc.init_path () ppx_import-1.10.0/src/compat/types_desc_ge_000.ml000066400000000000000000000001351425210733100215670ustar00rootroot00000000000000let get_desc x = x.Types.desc let row_fields x = x.Types.row_fields let row_field_repr x = x ppx_import-1.10.0/src/compat/types_desc_ge_414.ml000066400000000000000000000001521425210733100215770ustar00rootroot00000000000000let get_desc = Types.get_desc let row_fields = Types.row_fields let row_field_repr = Types.row_field_repr ppx_import-1.10.0/src/compat/types_module_type_ge_000.ml000066400000000000000000000001661425210733100232030ustar00rootroot00000000000000type module_type_407 = Types.module_type let migrate_module_type : Types.module_type -> module_type_407 = fun x -> x ppx_import-1.10.0/src/compat/types_module_type_ge_408.ml000066400000000000000000000006541425210733100232210ustar00rootroot00000000000000type module_type_407 = | Mty_ident of Path.t | Mty_signature of Types.signature | Mty_functor of Ident.t * Types.module_type option * Types.module_type | Mty_alias of unit * Path.t let migrate_module_type : Types.module_type -> module_type_407 = function | Mty_ident p -> Mty_ident p | Mty_signature s -> Mty_signature s | Mty_functor (i, mto, mt) -> Mty_functor (i, mto, mt) | Mty_alias p -> Mty_alias ((), p) ppx_import-1.10.0/src/compat/types_module_type_ge_410.ml000066400000000000000000000011471425210733100232100ustar00rootroot00000000000000type module_type_407 = | Mty_ident of Path.t | Mty_signature of Types.signature | Mty_functor of Ident.t * Types.module_type option * Types.module_type | Mty_alias of unit * Path.t let migrate_module_type : Types.module_type -> module_type_407 = function | Mty_ident p -> Mty_ident p | Mty_signature s -> Mty_signature s | Mty_functor (fp, mt) -> ( match fp with | Unit -> Mty_functor (Ident.create_local "_", None, mt) | Named (i, mt) -> let i = match i with None -> Ident.create_local "_" | Some i -> i in Mty_functor (i, Some mt, mt) ) | Mty_alias p -> Mty_alias ((), p) ppx_import-1.10.0/src/compat/types_signature_item_ge_000.ml000066400000000000000000000002061425210733100236670ustar00rootroot00000000000000type signature_item_407 = Types.signature_item let migrate_signature_item : Types.signature_item -> signature_item_407 = fun x -> x ppx_import-1.10.0/src/compat/types_signature_item_ge_408.ml000066400000000000000000000017221425210733100237070ustar00rootroot00000000000000type signature_item_407 = | Sig_value of Ident.t * Types.value_description | Sig_type of Ident.t * Types.type_declaration * Types.rec_status | Sig_typext of Ident.t * Types.extension_constructor * Types.ext_status | Sig_module of Ident.t * Types.module_declaration * Types.rec_status | Sig_modtype of Ident.t * Types.modtype_declaration | Sig_class of Ident.t * Types.class_declaration * Types.rec_status | Sig_class_type of Ident.t * Types.class_type_declaration * Types.rec_status let migrate_signature_item : Types.signature_item -> signature_item_407 = function | Sig_value (id, vd, _) -> Sig_value (id, vd) | Sig_type (id, td, r, _) -> Sig_type (id, td, r) | Sig_typext (id, ec, es, _) -> Sig_typext (id, ec, es) | Sig_module (id, _, md, rs, _) -> Sig_module (id, md, rs) | Sig_modtype (id, td, _) -> Sig_modtype (id, td) | Sig_class (id, cd, rs, _) -> Sig_class (id, cd, rs) | Sig_class_type (id, ctd, rs, _) -> Sig_class_type (id, ctd, rs) ppx_import-1.10.0/src/compat/types_type_kind_ge_000.ml000066400000000000000000000001541425210733100226400ustar00rootroot00000000000000type type_kind_412 = Types.type_kind let migrate_type_kind : Types.type_kind -> type_kind_412 = fun x -> x ppx_import-1.10.0/src/compat/types_type_kind_ge_413.ml000066400000000000000000000006471425210733100226570ustar00rootroot00000000000000type ('lbl, 'cstr) type_kind_412 = | Type_abstract | Type_record of 'lbl list * Types.record_representation | Type_variant of 'cstr list | Type_open let migrate_type_kind : ('lbl, 'cstr) Types.type_kind -> ('lbl, 'cstr) type_kind_412 = function | Type_abstract -> Type_abstract | Type_record (lbl, repr) -> Type_record (lbl, repr) | Type_variant (cstr, _) -> Type_variant cstr | Type_open -> Type_open ppx_import-1.10.0/src/dune000066400000000000000000000003701425210733100154350ustar00rootroot00000000000000(library (public_name ppx_import) (kind ppx_rewriter) (preprocess (pps ppxlib.metaquot)) (libraries ppxlib)) (rule (deps (glob_files compat/*.ml)) (targets compat.ml) (action (with-stdout-to %{targets} (run ./compat/gen.exe)))) ppx_import-1.10.0/src/ppx_import.ml000066400000000000000000000503231425210733100173150ustar00rootroot00000000000000module Tt = Ppx_types_migrate let lazy_env = lazy ( (* It is important that the typing environment is not evaluated right away, but only once the ppx-context has been loaded from the AST, so that Config.load_path and the rest of the environment context are correctly set. The environment setting should happen when reading the ppx-context attribute which is the very first structure/signature item sent to ppx rewriters. In particular, this happens before the [%import ] extensions are traversed, which are the places in this code where 'env' is forced. We would also have the option to not have a global environment, but recompute the typing environment on each [%import ] extension. We don't see any advantage in doing this, given that we compute the global/initial environment that is the same at all program points. *) (* We need to set recursive_types manually, because it is not part of the context automatically saved by Ast_mapper (as of 4.06), and this prevents loading the interface of recursive-types-using modules. On the other hand, setting recursive_types more often than necessary does not seem harmful. *) Ocaml_common.Clflags.recursive_types := true; Compat.init_path (); Ocaml_common.Compmisc.initial_env () ) let string_of_lid lid = let rec print lid acc = match lid with | Longident.Lident s -> s :: acc | Longident.Ldot (lid, id) -> print lid ("." :: id :: acc) | Longident.Lapply (la, lb) -> print la ("(" :: print lb (")" :: acc)) in String.concat "" (print lid []) let try_find_module ~loc env lid = (* Note: we are careful to call `Env.lookup_module` and not `Typetexp.lookup_module`, because we want to reason precisely about the possible failures: we want to handle the case where the module path does not exist, but let all the other errors (invalid .cmi format, etc.) bubble up to the error handler. `Env.lookup_module` allows to do this easily as it raises a well-identified `Not_found` exception, while `Typetexp.lookup_module` wraps the Not_found failure in user-oriented data and is not meant for catching. `Env.find_module` can raise `Not_found` again; we suspect that it will not in the cases where `lookup_module` returned correctly, but better be safe and bundle them in the same try..with. *) try let path = Compat.lookup_module ~loc lid env in let module_decl = Ocaml_common.Env.find_module path env in Some module_decl.md_type with Not_found -> None let try_find_module_type ~loc env lid = (* Here again we prefer to handle the `Not_found` case, so we use `Env.lookup_module` rather than `Typetexp.lookup_module`. *) try let _path, modtype_decl = Ocaml_common.Env.lookup_modtype ~loc lid env in Some ( match modtype_decl.mtd_type with | None -> Location.raise_errorf ~loc "[%%import]: cannot access the signature of the abstract module %s" (string_of_lid lid) | Some module_type -> module_type ) with Not_found -> None let rec try_open_module_type env module_type = match Compat.migrate_module_type module_type with | Mty_signature sig_items -> Some sig_items | Mty_functor _ -> None | Mty_ident path | Mty_alias (_, path) -> ( match try Some (Ocaml_common.Env.find_module path env) with Not_found -> None with | None -> None | Some module_decl -> try_open_module_type env module_decl.md_type ) let open_module_type ~loc env lid module_type = match try_open_module_type env module_type with | Some sig_items -> sig_items | None -> Location.raise_errorf ~loc "[%%import]: cannot find the components of %s" (string_of_lid lid) let locate_sig ~loc env lid = let head, path = match Ppxlib.Longident.flatten_exn lid with | head :: path -> (Longident.Lident head, path) | _ -> assert false in let head_module_type = match (try_find_module ~loc env head, lazy (try_find_module_type ~loc env head)) with | Some mty, _ -> mty | None, (lazy (Some mty)) -> mty | None, (lazy None) -> Location.raise_errorf ~loc "[%%import]: cannot locate module %s" (string_of_lid lid) in let get_sub_module_type (lid, module_type) path_item = let sig_items = open_module_type ~loc env lid module_type in let rec loop sig_items = match (sig_items : Compat.signature_item_407 list) with | Sig_module (id, {md_type; _}, _) :: _ when Ident.name id = path_item -> md_type | Sig_modtype (id, {mtd_type = Some md_type; _}) :: _ when Ident.name id = path_item -> md_type | _ :: sig_items -> loop sig_items | [] -> Location.raise_errorf ~loc "[%%import]: cannot find the signature of %s in %s" path_item (string_of_lid lid) in let sub_module_type = loop (List.map Compat.migrate_signature_item sig_items) in (Longident.Ldot (lid, path_item), sub_module_type) in let _lid, sub_module_type = List.fold_left get_sub_module_type (head, head_module_type) path in open_module_type ~loc env lid sub_module_type let try_get_tsig_item f ~loc:_ sig_items elem = let rec loop sig_items = match sig_items with | item :: sig_items -> ( match f elem item with Some x -> Some x | None -> loop sig_items ) | [] -> None in loop sig_items let get_type_decl ~loc sig_items parent_lid elem = let select_type elem sigi = match Compat.migrate_signature_item sigi with | Sig_type (id, type_decl, _) when Ident.name id = elem -> Some type_decl | _ -> None in match try_get_tsig_item select_type ~loc sig_items elem with | None -> Location.raise_errorf "[%%import]: cannot find the type %s in %s" elem (string_of_lid parent_lid) | Some decl -> decl let get_modtype_decl ~loc sig_items parent_lid elem = let select_modtype elem sigi = match Compat.migrate_signature_item sigi with | Sig_modtype (id, type_decl) when Ident.name id = elem -> Some type_decl | _ -> None in match try_get_tsig_item select_modtype ~loc sig_items elem with | None -> Location.raise_errorf "[%%import]: cannot find the module type %s in %s" elem (string_of_lid parent_lid) | Some decl -> decl let longident_of_path = Untypeast.lident_of_path let mknoloc (txt : 'a) : 'a Ppxlib.Location.loc = {txt; loc = Ppxlib.Location.none} let rec core_type_of_type_expr ~subst (type_expr : Ocaml_common.Types.type_expr) : Ppxlib.core_type = match Compat.get_desc type_expr with | Tvar None -> Ppxlib.Ast_helper.Typ.any () | Tvar (Some var) -> ( match List.assoc (`Var var) subst with | typ -> typ | exception Not_found -> Ppxlib.Ast_helper.Typ.var var ) | Tarrow (label, lhs, rhs, _) -> let label = Tt.copy_arg_label label in let lhs = core_type_of_type_expr ~subst lhs in let lhs = match label with | Optional _ -> ( match lhs with [%type: [%t? lhs] option] -> lhs | _ -> assert false ) | _ -> lhs in Ppxlib.Ast_helper.Typ.arrow label lhs (core_type_of_type_expr ~subst rhs) | Ttuple xs -> Ppxlib.Ast_helper.Typ.tuple (List.map (core_type_of_type_expr ~subst) xs) | Tconstr (path, args, _) -> ( let lid = longident_of_path path in let args = List.map (core_type_of_type_expr ~subst) args in match List.assoc (`Lid lid) subst with | {ptyp_desc = Ptyp_constr (lid, _); _} as typ -> {typ with ptyp_desc = Ptyp_constr (lid, args)} | _ -> assert false | exception Not_found -> Ppxlib.Ast_helper.Typ.constr {txt = longident_of_path path; loc = !Ppxlib.Ast_helper.default_loc} args ) | Tvariant row_desc -> let fields = Compat.row_fields row_desc |> List.map (fun (label, row_field) -> let label = mknoloc label in let desc = match Compat.row_field_repr row_field with | Types.Rpresent None -> Ppxlib.Rtag (label, true, []) | Types.Rpresent (Some ttyp) -> Ppxlib.Rtag (label, false, [core_type_of_type_expr ~subst ttyp]) | _ -> assert false in Ppxlib. { prf_desc = desc ; prf_loc = !Ppxlib.Ast_helper.default_loc ; prf_attributes = [] } ) in Ppxlib.Ast_helper.Typ.variant fields Closed None | _ -> assert false let ptype_decl_of_ttype_decl ~manifest ~subst ptype_name (ttype_decl : Ocaml_common.Types.type_declaration) : Ppxlib.type_declaration = let subst = let open Ppxlib in match manifest with | Some {ptyp_desc = Ptyp_constr (_, ptype_args); ptyp_loc; _} -> ( subst @ try List.map2 (fun (tparam : Ocaml_common.Types.type_expr) pparam -> match Compat.get_desc tparam with | Tvar (Some var) -> [(`Var var, pparam)] | Tvar None -> [] | _ -> assert false ) ttype_decl.type_params ptype_args |> List.concat with Invalid_argument _ -> Location.raise_errorf ~loc:ptyp_loc "Imported type has %d parameter(s), but %d are passed" (List.length ttype_decl.type_params) (List.length ptype_args) ) | None -> [] | _ -> assert false in let ptype_params = List.map2 (fun param _variance -> ( core_type_of_type_expr ~subst param , (* The equivalent of not specifying the variance explicitly. Since the very purpose of ppx_import is to include the full definition, it should always be sufficient to rely on the inferencer to deduce variance. *) (Ppxlib.Asttypes.NoVariance, Ppxlib.Asttypes.NoInjectivity) ) ) ttype_decl.type_params ttype_decl.type_variance and ptype_kind = let map_labels = List.map (fun (ld : Ocaml_common.Types.label_declaration) -> Ppxlib. { pld_name = {txt = Ocaml_common.Ident.name ld.ld_id; loc = ld.ld_loc} ; pld_mutable = Tt.copy_mutable_flag ld.ld_mutable ; pld_type = core_type_of_type_expr ~subst ld.ld_type ; pld_loc = ld.ld_loc ; pld_attributes = Tt.copy_attributes ld.ld_attributes } ) in Ppxlib.( match Compat.migrate_type_kind ttype_decl.type_kind with | Type_abstract -> Ptype_abstract | Type_open -> Ptype_open | Type_record (labels, _) -> Ptype_record (map_labels labels) | Type_variant constrs -> let map_args (constrs : Ocaml_common.Types.constructor_arguments) = match constrs with | Cstr_tuple args -> Pcstr_tuple (List.map (core_type_of_type_expr ~subst) args) | Cstr_record labels -> Pcstr_record (map_labels labels) in Ptype_variant ( constrs |> List.map (fun (cd : Ocaml_common.Types.constructor_declaration) -> let pcd_res = match cd.cd_res with | Some x -> Some (core_type_of_type_expr ~subst x) | None -> None in { pcd_name = {txt = Ocaml_common.Ident.name cd.cd_id; loc = cd.cd_loc} ; pcd_vars = [] ; pcd_args = map_args cd.cd_args ; pcd_res ; pcd_loc = cd.cd_loc ; pcd_attributes = Tt.copy_attributes cd.cd_attributes } ) )) and ptype_manifest = match ttype_decl.type_manifest with | Some typ -> Some (core_type_of_type_expr ~subst typ) | None -> manifest in { ptype_name ; ptype_params ; ptype_kind ; ptype_manifest ; ptype_cstrs = [] ; ptype_private = Tt.copy_private_flag ttype_decl.type_private ; ptype_attributes = Tt.copy_attributes ttype_decl.type_attributes ; ptype_loc = ttype_decl.type_loc } let subst_of_manifest ({ptyp_attributes; ptyp_loc; _} : Ppxlib.core_type) = let open Ppxlib in let rec subst_of_expr expr = match expr with | [%expr [%e? {pexp_desc = Pexp_ident {txt = src; _}; _}] := [%e? { pexp_desc = Pexp_ident dst ; pexp_attributes ; pexp_loc ; pexp_loc_stack }]] -> [ ( `Lid src , { ptyp_loc = pexp_loc ; ptyp_loc_stack = pexp_loc_stack ; ptyp_attributes = pexp_attributes ; ptyp_desc = Ptyp_constr (dst, []) } ) ] | [%expr [%e? {pexp_desc = Pexp_ident {txt = src; _}; _}] := [%e? { pexp_desc = Pexp_ident dst ; pexp_attributes ; pexp_loc ; pexp_loc_stack }]; [%e? rest]] -> ( `Lid src , { ptyp_loc = pexp_loc ; ptyp_loc_stack = pexp_loc_stack ; ptyp_attributes = pexp_attributes ; ptyp_desc = Ptyp_constr (dst, []) } ) :: subst_of_expr rest | {pexp_loc; _} -> Location.raise_errorf ~loc:pexp_loc "Invalid [@with] syntax" in let find_attr s attrs = try Some (List.find (fun {attr_name = x; _} -> x.txt = s) attrs).attr_payload with Not_found -> None in match find_attr "with" ptyp_attributes with | None -> [] | Some (PStr [{pstr_desc = Pstr_eval (expr, []); _}]) -> subst_of_expr expr | Some _ -> Location.raise_errorf ~loc:ptyp_loc "Invalid [@with] syntax" let uncapitalize = String.uncapitalize_ascii let is_self_reference ~input_name lid = let fn = input_name |> Filename.basename |> Filename.chop_extension |> uncapitalize in match lid with | Ppxlib.Ldot _ -> let mn = Ppxlib.Longident.flatten_exn lid |> List.hd |> uncapitalize in fn = mn | _ -> false let type_declaration ~tool_name ~input_name (type_decl : Ppxlib.type_declaration) = let open Ppxlib in match type_decl with | { ptype_attributes ; ptype_name ; ptype_manifest = Some {ptyp_desc = Ptyp_extension ({txt = "import"; loc}, payload); _} ; _ } -> ( match payload with | PTyp ({ptyp_desc = Ptyp_constr ({txt = lid; loc}, _); _} as manifest) -> if tool_name = "ocamldep" then (* Just put it as manifest *) if is_self_reference ~input_name lid then {type_decl with ptype_manifest = None} else {type_decl with ptype_manifest = Some manifest} else Ast_helper.with_default_loc loc (fun () -> let ttype_decl = let env = Lazy.force lazy_env in match lid with | Lapply _ -> Location.raise_errorf ~loc "[%%import] cannot import a functor application %s" (string_of_lid lid) | Lident _ as head_id -> (* In this case, we know for sure that the user intends this lident as a type name, so we use Typetexp.find_type and let the failure cases propagate to the user. *) Compat.find_type env ~loc head_id |> snd | Ldot (parent_id, elem) -> let sig_items = locate_sig ~loc env parent_id in get_type_decl ~loc sig_items parent_id elem in let m, s = if is_self_reference ~input_name lid then (None, []) else let subst = subst_of_manifest manifest in let subst = subst @ [ ( `Lid (Lident (Longident.last_exn lid)) , Ast_helper.Typ.constr {txt = Lident ptype_name.txt; loc = ptype_name.loc} [] ) ] in (Some manifest, subst) in let ptype_decl = ptype_decl_of_ttype_decl ~manifest:m ~subst:s ptype_name ttype_decl in {ptype_decl with ptype_attributes} ) | _ -> Location.raise_errorf ~loc "Invalid [%%import] syntax" ) | _ -> type_decl let rec cut_tsig_block_of_rec_types accu (tsig : Compat.signature_item_407 list) = match tsig with | Sig_type (id, ttype_decl, Trec_next) :: rest -> cut_tsig_block_of_rec_types ((id, ttype_decl) :: accu) rest | _ -> (List.rev accu, tsig) let rec psig_of_tsig ~subst (tsig : Compat.signature_item_407 list) : Ppxlib.signature_item list = let open Ppxlib in match tsig with | Sig_type (id, ttype_decl, rec_flag) :: rest -> let accu = [(id, ttype_decl)] in let rec_flag, (block, rest) = match rec_flag with | Trec_not -> (Nonrecursive, (accu, rest)) | Trec_first -> (Recursive, cut_tsig_block_of_rec_types accu rest) | Trec_next -> assert false in let block = block |> List.map (fun (id, ttype_decl) -> ptype_decl_of_ttype_decl ~manifest:None ~subst (mknoloc (Ocaml_common.Ident.name id)) ttype_decl ) in let psig_desc = Psig_type (rec_flag, block) in {psig_desc; psig_loc = Location.none} :: psig_of_tsig ~subst rest | Sig_value (id, {val_type; val_kind; val_loc; val_attributes; _}) :: rest -> let pval_prim = match val_kind with | Val_reg -> [] | Val_prim p -> if p.prim_native_name <> "" then [p.prim_name; p.prim_native_name] else [p.prim_name] | _ -> assert false in { psig_desc = Psig_value { pval_name = mknoloc (Ocaml_common.Ident.name id) ; pval_loc = val_loc ; pval_attributes = Tt.copy_attributes val_attributes ; pval_prim ; pval_type = core_type_of_type_expr ~subst val_type } ; psig_loc = val_loc } :: psig_of_tsig ~subst rest | [] -> [] | _ -> assert false let module_type ~tool_name ~input_name (package_type : Ppxlib.package_type) = let open Ppxlib in let ({txt = lid; loc} as alias), subst = package_type in if tool_name = "ocamldep" then if is_self_reference ~input_name lid then (* Create a dummy module type to break the circular dependency *) Ast_helper.Mty.mk ~attrs:[] (Pmty_signature []) else (* Just put it as alias *) Ast_helper.Mty.mk ~attrs:[] (Pmty_alias alias) else Ppxlib.Ast_helper.with_default_loc loc (fun () -> let env = Lazy.force lazy_env in let tmodtype_decl = match lid with | Longident.Lapply _ -> Location.raise_errorf ~loc "[%%import] cannot import a functor application %s" (string_of_lid lid) | Longident.Lident _ as head_id -> (* In this case, we know for sure that the user intends this lident as a module type name, so we use Typetexp.find_type and let the failure cases propagate to the user. *) Compat.find_modtype env ~loc head_id |> snd | Longident.Ldot (parent_id, elem) -> let sig_items = locate_sig ~loc env parent_id in get_modtype_decl ~loc sig_items parent_id elem in match tmodtype_decl with | {mtd_type = Some (Mty_signature tsig); _} -> let subst = List.map (fun ({txt; _}, typ) -> (`Lid txt, typ)) subst in let psig = psig_of_tsig ~subst (List.map Compat.migrate_signature_item tsig) in Ast_helper.Mty.mk ~attrs:[] (Pmty_signature psig) | {mtd_type = None; _} -> Location.raise_errorf ~loc "Imported module is abstract" | _ -> Location.raise_errorf ~loc "Imported module is indirectly defined" ) let type_declaration_expand ~ctxt type_decl = let tool_name = Ppxlib.Expansion_context.Extension.tool_name ctxt in let input_name = Ppxlib.Expansion_context.Extension.input_name ctxt in type_declaration ~tool_name ~input_name type_decl let module_declaration_expand ~ctxt package_type = let tool_name = Ppxlib.Expansion_context.Extension.tool_name ctxt in let input_name = Ppxlib.Expansion_context.Extension.input_name ctxt in module_type ~tool_name ~input_name package_type let type_declaration_extension = Ppxlib.Extension.__declare_ppx_import "import" type_declaration_expand let module_declaration_extension = Ppxlib.Extension.V3.declare "import" Ppxlib.Extension.Context.module_type Ppxlib.Ast_pattern.(ptyp (ptyp_package __)) module_declaration_expand let type_declaration_rule = Ppxlib.Context_free.Rule.extension type_declaration_extension let module_declaration_rule = Ppxlib.Context_free.Rule.extension module_declaration_extension let () = Ppxlib.Driver.register_transformation ~rules:[type_declaration_rule; module_declaration_rule] "ppx_import" ppx_import-1.10.0/src/ppx_types_migrate.ml000066400000000000000000000015211425210733100206530ustar00rootroot00000000000000module At = Asttypes (* copy_mutable_flag / private_flag / arg_label are not exported by Ppxlib so not worth the pain of the hack *) let copy_mutable_flag (l : At.mutable_flag) : Ppxlib.mutable_flag = match l with At.Immutable -> Ppxlib.Immutable | At.Mutable -> Ppxlib.Mutable let copy_private_flag (l : At.private_flag) : Ppxlib.private_flag = match l with At.Private -> Ppxlib.Private | At.Public -> Ppxlib.Public let copy_arg_label (l : At.arg_label) : Ppxlib.arg_label = match l with | At.Nolabel -> Ppxlib.Nolabel | At.Labelled l -> Ppxlib.Labelled l | At.Optional x -> Ppxlib.Optional x (* Here we want to do a hack due to the large type *) let copy_attributes (attrs : Parsetree.attributes) = let td = Ast_helper.Typ.any ~attrs () in let tb = Ppxlib_ast.Selected_ast.Of_ocaml.copy_core_type td in tb.ptyp_attributes ppx_import-1.10.0/src_test/000077500000000000000000000000001425210733100156165ustar00rootroot00000000000000ppx_import-1.10.0/src_test/ppx_deriving/000077500000000000000000000000001425210733100203145ustar00rootroot00000000000000ppx_import-1.10.0/src_test/ppx_deriving/dune000066400000000000000000000002011425210733100211630ustar00rootroot00000000000000(test (name test_ppx_import) (preprocess (staged_pps ppx_import ppx_deriving.show)) (libraries compiler-libs.common oUnit)) ppx_import-1.10.0/src_test/ppx_deriving/stuff.ml000066400000000000000000000006671425210733100220060ustar00rootroot00000000000000type a = A1 | A2 of string type b = {b1 : a; b2 : string; b3 : Int64.t} type c = [`A | `B | `C of string] type d = Int64.t type e = string * int module type S = sig type f = int end type 'a g = Foo of 'a type h = Zero | Succ of h module MI = struct type i = int end open MI type nonrec i = I of i module type S_rec = sig type t = A of u and u = B of t end module type S_optional = sig val f : ?opt:int -> unit -> unit end ppx_import-1.10.0/src_test/ppx_deriving/test_intf.ml000066400000000000000000000000341425210733100226420ustar00rootroot00000000000000type a = [%import: Stuff.a] ppx_import-1.10.0/src_test/ppx_deriving/test_intf.mli000066400000000000000000000000341425210733100230130ustar00rootroot00000000000000type a = [%import: Stuff.a] ppx_import-1.10.0/src_test/ppx_deriving/test_ppx_import.ml000066400000000000000000000040031425210733100241030ustar00rootroot00000000000000open OUnit2 type a = [%import: Stuff.a] type b = [%import: Stuff.b] type c = [%import: Stuff.c] type d = [%import: Stuff.d] type e = [%import: Stuff.e] type f = [%import: Stuff.S.f] type 'a g = [%import: 'a Stuff.g] type 'b g' = [%import: 'b Stuff.g] type h = [%import: Stuff.h] module MI = Stuff.MI type i = [%import: Stuff.i] module type S_rec = [%import: (module Stuff.S_rec)] let test_constr _ctxt = ignore [A1; A2 "a"]; ignore (Stuff.A1 = A1); ignore (Test_intf.A1 = A1); ignore {b1 = A1; b2 = "x"; b3 = Int64.zero}; ignore (`A : c); ignore (Int64.zero : d); ignore (("a", 1) : e); ignore (Succ Zero : h); ignore (I 1 : i) type a' = [%import: Stuff.a] [@@deriving show] let test_deriving _ctxt = assert_equal ~printer:(fun x -> x) "(Stuff.A2 \"a\")" (show_a' (A2 "a")) module type S_optional = [%import: (module Stuff.S_optional)] module Test_optional : S_optional = struct let f ?(opt = 0) () = ignore opt end type longident = [%import: Longident.t] [@@deriving show] type package_type = [%import: (Parsetree.package_type [@with core_type := (Parsetree.core_type [@printer Pprintast.core_type]); Asttypes.loc := (Asttypes.loc [@polyprinter fun pp fmt x -> pp fmt x.Asttypes.txt]); Longident.t := (Longident.t [@printer pp_longident])] )] [@@deriving show] module type Hashable = [%import: (module Hashtbl.HashedType)] type self_t = [%import: Test_self_import.t] let test_self_import _ctxt = let v : self_t = `OptionA in Test_self_import.validate_option v module type Self_S = [%import: (module Test_self_import.S)] module Self_M : Self_S = struct let test () = "test" end let test_self_import_module_type _ctxt = let m = (module Self_M : Self_S) in Test_self_import.validate_module_type m let suite = "Test ppx_import" >::: [ "test_constr" >:: test_constr ; "test_deriving" >:: test_deriving ; "test_self_import" >:: test_self_import ; "test_self_import_module_type" >:: test_self_import_module_type ] let _ = run_test_tt_main suite ppx_import-1.10.0/src_test/ppx_deriving/test_self_import.ml000066400000000000000000000004511425210733100242300ustar00rootroot00000000000000type t = [%import: Test_self_import.t] module type S = [%import: (module Test_self_import.S)] let validate_option = function | `OptionA -> assert true | `OptionB -> assert true | _ -> assert false let validate_module_type m = let module M = (val m : S) in assert (M.test () = "test") ppx_import-1.10.0/src_test/ppx_deriving/test_self_import.mli000066400000000000000000000002431425210733100244000ustar00rootroot00000000000000type t = [`OptionA | `OptionB] module type S = sig val test : unit -> string end val validate_option : t -> unit val validate_module_type : (module S) -> unit ppx_import-1.10.0/src_test/ppx_deriving_sexp/000077500000000000000000000000001425210733100213535ustar00rootroot00000000000000ppx_import-1.10.0/src_test/ppx_deriving_sexp/dune000066400000000000000000000002131425210733100222250ustar00rootroot00000000000000(test (name test_ppx_deriving_sexp) (enabled_if (>= %{ocaml_version} "4.10.0")) (preprocess (staged_pps ppx_import ppx_sexp_conv))) ppx_import-1.10.0/src_test/ppx_deriving_sexp/sorts.ml000066400000000000000000000000601425210733100230530ustar00rootroot00000000000000type family = InSProp | InProp | InSet | InType ppx_import-1.10.0/src_test/ppx_deriving_sexp/test_ppx_deriving_sexp.ml000066400000000000000000000003211425210733100264750ustar00rootroot00000000000000type sorts = [%import: Sorts.family] [@@deriving sexp] let main () = let test = Sorts.InType in let sexp = sexp_of_sorts test in let orig = sorts_of_sexp sexp in assert (orig = test) let _ = main ()