pax_global_header00006660000000000000000000000064145117765220014524gustar00rootroot0000000000000052 comment=c865bcff3a76a642829bf7536602ef6d4863435a coq-elpi-1.19.3/000077500000000000000000000000001451177652200133305ustar00rootroot00000000000000coq-elpi-1.19.3/.gitattributes000066400000000000000000000000401451177652200162150ustar00rootroot00000000000000*.elpi linguist-language=prolog coq-elpi-1.19.3/.github/000077500000000000000000000000001451177652200146705ustar00rootroot00000000000000coq-elpi-1.19.3/.github/workflows/000077500000000000000000000000001451177652200167255ustar00rootroot00000000000000coq-elpi-1.19.3/.github/workflows/doc.yml000066400000000000000000000025601451177652200202200ustar00rootroot00000000000000# This is a basic workflow to help you get started with Actions name: DOC # Controls when the action will run. Triggers the workflow on push or pull request # events but only for the master branch on: push: branches: [ master ] pull_request: branches: [ master ] jobs: build: name: Build doc runs-on: ubuntu-latest steps: - name: workaround bug run: sudo apt-get update - name: checkout uses: actions/checkout@v2 - name: setup ocaml uses: avsm/setup-ocaml@v1 with: ocaml-version: 4.09.1 - name: install deps run: | export OPAMYES=true opam repo add coq https://coq.inria.fr/opam/released opam repo add coq-dev https://coq.inria.fr/opam/core-dev opam repo add extra-dev https://coq.inria.fr/opam/extra-dev opam update opam install coq-serapi . sudo apt-get update sudo apt-get install python3-pip -y pip3 install git+https://github.com/cpitclaudel/alectryon.git@c8ab1ec - name: build doc run: opam exec -- make doc COQ_ELPI_ALREADY_INSTALLED=1 - name: Save artifact uses: actions/upload-artifact@v2 with: path: doc - name: deploy uses: JamesIves/github-pages-deploy-action@4.1.4 if: ${{ github.ref == 'refs/heads/master' }} with: branch: gh-pages folder: doc coq-elpi-1.19.3/.github/workflows/main.yml000066400000000000000000000060671451177652200204050ustar00rootroot00000000000000# This is a basic workflow to help you get started with Actions name: CI # Controls when the action will run. Triggers the workflow on push or pull request # events but only for the master branch on: push: branches: [ master ] tags: [ "v*.*.*" ] pull_request: branches: [ master ] jobs: build: runs-on: ubuntu-latest strategy: matrix: coq_version: - '8.18' ocaml_version: - '4.09-flambda' - '4.13-flambda' steps: - uses: actions/checkout@v2 - uses: coq-community/docker-coq-action@v1 with: opam_file: './coq-elpi.opam' coq_version: ${{ matrix.coq_version }} ocaml_version: ${{ matrix.ocaml_version }} export: 'OPAMWITHTEST' install: | startGroup "Install dependencies" opam pin add -n -y -k path $PACKAGE $WORKDIR opam update -y opam install -y -j 2 $PACKAGE --deps-only endGroup env: OPAMWITHTEST: 'true' play: runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 - uses: avsm/setup-ocaml@v2 with: ocaml-compiler: 5.1.x - run: | opam install ./coq-elpi.opam release: runs-on: ubuntu-latest if: startsWith(github.ref, 'refs/tags/') needs: [build] steps: - name: Checkout uses: actions/checkout@v3 - name: Inject slug/short variables uses: rlespinasse/github-slug-action@v4 - name: Create archive run: | VERSION="${GITHUB_REF_NAME_SLUG#v}" git archive -o coq-elpi-$VERSION.tar.gz --prefix=coq-elpi-$VERSION/ $GITHUB_SHA . - name: Release uses: softprops/action-gh-release@v1 with: files: coq-elpi-*.tar.gz fail_on_unmatched_files: true prerelease: true generate_release_notes: true name: Coq-Elpi ${{ github.ref }} for Coq XXX - name: Use OCaml 4.14.x uses: avsm/setup-ocaml@v2 with: ocaml-compiler: 4.14.x opam-local-packages: | !coq-elpi.opam - name: Write PAT env: OPAM_PUBLISH_TOKEN: ${{ secrets.OPAM_PUBLISH_TOKEN }} run: | mkdir -p ~/.opam/plugins/opam-publish printf "$OPAM_PUBLISH_TOKEN" > ~/.opam/plugins/opam-publish/coqelpibot.token - name: Setup SSH uses: webfactory/ssh-agent@v0.8.0 with: ssh-private-key: ${{ secrets.BOT_SSH_KEY }} - name: Install opam-publish # 2.0.3 because more recent versions do not respect OPAMYES run: opam install -y -j 2 opam-publish=2.0.3 - name: Publish run: | eval $(opam env) git config --global user.name coqelpibot git config --global user.email coqelpibot@inria.fr OPAM_SUITE=released TAG=`git tag --sort=-v:refname|head -1` opam-publish --tag=$TAG --packages-directory=$OPAM_SUITE/packages --repo=coq/opam --no-browser -v ${TAG##v} https://github.com/LPCIC/coq-elpi/releases/download/$TAG/coq-elpi-${TAG##v}.tar.gz coq-elpi-1.19.3/.gitignore000066400000000000000000000007271451177652200153260ustar00rootroot00000000000000*.o *.cmx *.cmo *.cmi *.a *.cmxa *.cmxs *.cma *.cmt *.cmti *.annot .*~ .*.swp *.vo *.vos *.vok *.d *.glob .*.aux *.html *.txt *.crashcoqide \#*\# etc/__pycache__/ /.deps.elpi src/coq_elpi_config.ml src/coq_elpi_vernacular_syntax.ml src/coq_elpi_arg_syntax.ml src/coq_elpi_builtins_HOAS.ml doc/ Makefile.coq Makefile.coq.conf .merlin Makefile.*.coq Makefile.*.coq.conf tests/test_glob/*.css META *.cache apps/coercion/src/coq_elpi_coercion_hook.ml .filestoinstallcoq-elpi-1.19.3/.nix/000077500000000000000000000000001451177652200142045ustar00rootroot00000000000000coq-elpi-1.19.3/.nix/config.nix000066400000000000000000000015461451177652200161770ustar00rootroot00000000000000{ format = "1.0.0"; attribute = "coq-elpi"; default-bundle = "coq-8.17"; bundles = { "coq-8.17".coqPackages = { coq.override.version = "8.17"; hierarchy-builder.override.version = "master"; hierarchy-builder-shim.job = false; mathcomp.override.version = "master"; mathcomp.job = true; odd-order.override.version = "master"; odd-order.job = true; mathcomp-analysis.override.version = "hierarchy-builder"; mathcomp-analysis.job = true; mathcomp-classical.override.version = "hierarchy-builder"; mathcomp-classical.job = true; mathcomp-single-planB-src.job = false; mathcomp-single-planB.job = false; mathcomp-single.job = false; }; }; cachix.coq = {}; cachix.math-comp = {}; cachix.coq-community = {}; cachix.coq-elpi.authToken = "CACHIX_AUTH_TOKEN"; } coq-elpi-1.19.3/.nix/coq-nix-toolbox.nix000066400000000000000000000000531451177652200177640ustar00rootroot00000000000000"e2a21e50cd134b50c7e590b66ad14ec4905e16cd" coq-elpi-1.19.3/.vscode/000077500000000000000000000000001451177652200146715ustar00rootroot00000000000000coq-elpi-1.19.3/.vscode/settings.json000066400000000000000000000017271451177652200174330ustar00rootroot00000000000000{ "files.exclude": { "**/*.o": true, "**/*.cmx": true, "**/*.cmo": true, "**/*.cmi": true, "**/*.a": true, "**/*.cmxa": true, "**/*.cmxs": true, "**/*.cma": true, "**/*.cmt": true, "**/*.cmti": true, "**/*.annot": true, "**/.*~": true, "**/.*.swp": true, "**/*.vo": true, "**/*.vos": true, "**/*.vok": true, "**/*.d": true, "**/*.glob": true, "**/.*.aux": true, "**/*.html": true, "**/*.crashcoqide": true, "**/\\#*\\#": true, ".deps.elpi": true, "src/coq_elpi_config.ml": true, "src/coq_elpi_vernacular_syntax.ml": true, "**/Makefile.coq": true, "**/Makefile.coq.conf": true, "**/.merlin": true }, "restructuredtext.confPath": "${workspaceFolder}/alectryon/recipes/sphinx", "ocaml.server.args": [ "--fallback-read-dot-merlin" ], }coq-elpi-1.19.3/Changelog.md000066400000000000000000001225141451177652200155460ustar00rootroot00000000000000# Changelog ## [1.19.3] - 12/10/2023 Requires Elpi 1.16.5 and Coq 8.18. ### Misc - Fix `Elpi Export` broken when used from VsCoq2 ### APIs - New `ltac1-tactic` opaque data type - New `tac` argument constructor - Change `coq.ltac.call-ltac1` now accepts either a string (tactic name) or a tactic expression (of type `ltac1-tactic`) - New `ltac_tactic:(...)` syntax to pass tactic expressions to Elpi tactics ## [1.19.1] - 30/08/2023 Requires Elpi 1.16.5 and Coq 8.18. ### Misc - Automate release process ## [1.19.0] - 04/08/2023 Requires Elpi 1.16.5 and Coq 8.18. ### APPS - New `coercion` app providing `coercion` predicate to program coercions (thanks @proux01). This app is experimental. ### API - Removed option `@nonuniform!` as it disappears from Coq 8.18. (c.f. https://github.com/coq/coq/pull/17716 ) ## [1.18.0] - 27/07/2023 Requires Elpi 1.16.5 and Coq 8.17. ### Doc - Mention the trace browser for VSCode in the Elpi tutorial. ### API - New `coq.elpi.accumulate-clauses` takes a list of clauses which share the same DB and accumulation site - New `coq.elpi.add-predicate` to declare the signature of a new predicate into a Db - New `coq.elpi.predicate` to build a term of type `prop` out of a predicate name and arguments - Change `coq.env.global` now relates a term with a gref, instead of working one way only - Change `coq.elpi.accumulate*` generalise clauses over global universe level, and error if algebraic levels are present. It used to warn if levels were present. - New `coq.elaborate*skeleton` support the `@no-tc!` option to disable type class resolution - New `@global!` option for `coq.elpi.accumulate*` - New `coq.env.current-section-path` - New `coq.TC.db-tc` giving all type classes - New `coq.reduction.eta-contract` ### HOAS - Fix evar declarations were (rarely) generated at the wrong depth, possibly resulting in variable captures in types containing binders - Fix `assert false` in evar instantiation readback (eta contraction code was incomplete) - Fix resiliency in case a goal is closed by side effect (was raising fatal errors such as "Not a goal" or "Not a variable after goal") - Change assigning a hole linked to an evar *always* triggers type checking. This is necessary even if the term being assigned is well typed since one may still need to declare some universe constraints. - Change propagate type constraints in `Prop` inward (Coq 8.17 only). Eg. `Check (T -> _) : Prop` fails in 8.17 since `_` is assumed to be in `Type`. We propagate the constraint ourselves across `->`, `/\`, `\/` and `~`. - Quotations `{{ ... }}` are now parsed by Coq ensuring the end of input is reached. Spurious text results in a parse error. For example `{{ f ) }}` is no more accepted, as well as `{{ _.x }}` ### Vernacular - New `Elpi Print` also print the program in `.txt` format ### Runtime - Change compilation cache able to prevent most of lengthy compilations in Hierarchy-Builder for MathComp 2.0. In some cases Coq-Elpi is more picky about the order of accumulated files, in particular a file containing the spilling of a predicate `{p}` needs to be accumulated after the type or mode of `p` is declared ### APPS - `derive Inductive i {A}` now sets `A` implicit status globally - `lock Definition f {A}` now sets `A` implicit status globally ## [1.17.1] - 09/03/2023 Requires Elpi 1.16.5 and Coq 8.17. ### API: - New `coq.int->uint63` and `coq.float->float64` - Fix bug introduced in 1.17.0 affecting `coq.ltac.call-ltac1` ## [1.17.0] - 13/02/2023 Requires Elpi 1.16.5 and Coq 8.17. ### API - New `coq.modpath->library` - New `coq.modtypath->library` - Fix `coq.env.*` APIs generating inductives, definitions and modules now emit metadata in the `.glob` files so that `coqdoc` can generate hyperlinks ### APPS - Add `NES.{List,Print}`. - Support relative paths in `NES.{Open,List,Print}` (path `_.P` references top-level namespace `P`, paths without a leading `_.` are relative to the current namespace) ## [1.16.0] - 10/11/2022 Requires Elpi 1.16.5 and Coq 8.16. The main change is the `derive` app which must now be loaded by importing `derive.std` (just loading `derive` won't work). See the [new derive documentation](apps/derive). ### API - Change `coq.env.module` and `coq.env.module-type` do not fail if the module (type) contains a mutual inductive. The resulting `gref` is going to me unusable with most APIs, though. - Change `coq.env.module` returns a ADT describing the module contents - Change `coq.gref->path` and `coq.gref->id` do work on `gref` which point to mutual inductives. - New `coq.env.term-dependencies` computing all the `grefs` occurring in a term. - New `coq.redflag` and `coq.redflags` types for `@redflags!` option understood by `coq.reduction.lazy.*` `and coq.reduction.cbv.norm` - New `coq.env.fresh-global-id` ### APPS - Change `derive` usage. One should now import `From elpi.apps Require Import derive.std` - Change derivations `eq` and `eqOK` move to `derive.legacy` - New derivations `eqb` and `eqbOK` subsuming the previous ones ## [1.15.6] - 27-08-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix parse error location display for quotation code - Fix HOAS of inductives with non-uniform parameters ## [1.15.5] - 30-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix parse error location display for inline code - Fix HOAS of evars: pruning was not propagated to the type of the evar ## [1.15.4] - 26-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix lexical analysis inside quotations error location display - Fix drop of universe constraints attached to automatically generates universe levels (eg when `sort (typ X)` is passed to Coq) - Fix nix CI ## [1.15.3] - 20-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix parse error location display ## [1.15.2] - 19-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - API: - Fix `coq.env.indt-decl` correctly handles universes in parameters of universe polymorphic inductive - Fix `coq.typecheck-indt-decl` ignores non uniform parameters to compute the universe level of the inductive - Fix `coq.elaborate-indt-decl-skeleton` ignores non uniform parameters to compute the universe level of the inductive ## [1.15.1] - 16-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - API: - Fix `coq.elaborate*skeleton` does refresh universes - New `@keepunivs!` attribute to force skeleton APIs to not refresh universes. This is useful to keep a link between a universe declaration and the declaration itself but still elaborate it - Fix Coq-Elpi is reentrant when commands call tactics ## [1.15.0] - 13-07-2022 Requires Elpi 1.16.5 and Coq 8.16. The main changes are: - experimental support for universe polymorphism. One can read and write universe polymorphic terms and manipulate their constraint declarations. Terms now have a new `pglobal` term constructor, akin to `global` but for global references to universe polymorphic terms, also carrying a universe instance. The attribute `@uinstance!` can be used to pass or retrieve a universe instance to/from APIs to access the Coq environment, as in `@uinstance! I => coq.env.typeof GR Ty_at_I`. The meaning of `@uinstance! I =>` depends if `I` is an unset variable or a concrete universe instance. In the former case the API generate a fresh universe instance (for `GR`) and assign it to `I`; in the latter case it uses the provided universe instance. See [coq-builtin](coq-builtin.elpi) for the full documentation - command arguments are elaborated by Coq (unless told otherwise). As a consequence arguments can use the full Coq syntax, including deep pattern matching and tactics in terms. Raw arguments are (and will remain) available, but don't support that yet ### APPS - New experimental support for polymorphic definitions in `locker` - New example of `clearbody` tactic taking a list of names in `eltac` - Change `derive` sets, *globally*, `Uniform Inductive Parameters`. See https://coq.inria.fr/refman/language/core/inductive.html#coq:flag.Uniform-Inductive-Parameters for reference. The immediate effect is that inductive types uniform parameters don't have to be repeated in the types of the constructors (they can't vary anyway). Non-uniform parameters and indexes have to be passed, as usual. If the flag is unset by the user `Coq-Elpi` will raise a warning since inference of non-uniform parameters is not implemented ### HOAS - Change arguments to commands are elaborated by Coq by default - New attribute `#[arguments(raw)]` to get arguments in raw format (as in version 1.14 or below) - Change raw inductive declaration using `|` to mark non-uniform parameters is expected to not pass uniform parameters to the inductive type (the same behavior applies to elaborated arguments, making the two consistent) - Change `coercion` attribute for record fields now takes values `off`, `regular` or `reversible` - New `pglobal` term constructor carrying a `gref` and a `univ-instance` for universe polymorphic terms - New `upoly-indt-decl` argument type for polymorphic inductive types declarations - New `upoly-const-decl` argument type for polymorphic definitions - New `upoly-decl` data type for universe parameters declarations, i.e. the `@{u1 u2 | u1 < u2}` Coq syntax one can use for inductives or definitions - New `upoly-decl-cumul` data type for universe parameters declarations, i.e. the `@{u1 u2 | u1 < u2}` Coq syntax one can use for cumulative inductives - Rename `univ` -> `sort` i.e. `(sort S)` is a `term` and `S` can be `prop` or `(type U)` where `U` is a `univ` - New `univ-instance` opaque type to represent how a polymorphic constant is instantiated, i.e. `(pglobal GR I)` where `GR` is a `gref` and `I` a `univ-instance` - New `univ.variable` opaque type for `univ` which are not algebraic. This data type is used in `upoly-decl` and `upoly-decl-cumul` ### API - New `coq.env.indc->indt` - New `coq.env.dependencies` to compute the dependencies of a `gref` - New `coq.env.transitive-dependencies` - New `@nonuniform!` and `@reversible!` for `coq.coercion.declare` - New `@uinstance!` attribute supported by many `coq.env.*` APIs that can be used to read/write the universe instance of polymorphic constants. E.g. `@uinstance! UI => coq.env.typeof GR Ty` can instantiate `Ty` to `UI` if provided or set `UI` to a fresh instance if not - New `@udecl!` attribute to declare polymorphic constants or inductives, like the `@{u1 u2 | u1 < u2}` Coq syntax - New `@udecl-cumul!` attribute to declare polymorphic inductives, like the `@{+u1 u2 | u1 < u2}` Coq syntax - New `@univpoly!` shorter version of `@udecl!`, like the `#[universes(polymorphic)]` Coq syntax (without giving any other `@{u1 u2 | u1 < u2}` directive) - New `@univpoly-cumul!` shorter version of `@udecl-cumul!`, like the `#[universes(polymorphic,cumulative)]` Coq syntax - New `coq.env.global` API to craft a `term` from a `gref`. When used with spilling `{coq.env.global GR}` gives either `(global GR)` or `(pglobal GR I)` depending on `GR` being universe polymorphic or not. It understands the `@unistance!` attribute for both reading or setting `I` - New `coq.env.univpoly?` to tell if a `gref` is universe polymorphic and how many parameters it has - Change `coq.univ.leq` -> `coq.sort.leq` - Change `coq.univ.eq` -> `coq.sort.eq` - Change `coq.univ.sup` -> `coq.sort.sup` - New `coq.sort.pts-triple` computes the resulting `sort` of a product - New `coq.univ.constraints` gives all the universe constraints in a first class form - Change `coq.univ.new` does not take a list anymore - New `coq.univ` to find a global universe - New `coq.univ.global?` tests if a universe is global - New `coq.univ.variable` links a `univ` to a `univ.variable` (imposing an equality constraint if needed) - New `coq.univ.variable.constraints` finds all constraints talking about a variable - New `coq.univ.variable.of-term` finds all variables occurring in a term - New `coq.univ-instance` links a `univ-instance` to a list of of `univ.variable` - New `coq.univ-instance.unify-eq` unifies two `univ-instance` (for the same `gref`) - New `coq.univ-instance.unify-leq` unifies two `univ-instance` (for the same `gref`) - New `coq.univ.set` OCaml's set for `univ` - New `coq.univ.map` OCaml's map for `univ` - New `coq.univ.variable.set` OCaml's set for `univ.variable` - New `coq.univ.variable.map` OCaml's map for `univ.variable` ### Vernacular - New `Accumulate File ` to be used in tandem with Coq 8.16 `From Extra Dependency as ` ## [1.14.0] - 07-04-2022 Requires Elpi 1.15.0 and Coq 8.15. ### Vernacular - All `Elpi Bla` commands accept (and ignore with a warning) unknown attributes, to be forward compatible ## [1.13.0] - 08-02-2022 Requires Elpi 1.14.1 and Coq 8.15. ### Performance - New 1 slot cache for context read back to improve the speed of FFI calls needing to read back a large `coq_context` - New `Conversion.t` for `gref` handwritten to minimize allocations - New terms of the form `(global ...)` are now hashconsed - New `extra_goals` postprocessing removing `declare-evar/rm-evar` pairs which happen naturally writing code like `coq.unify-eq {{ f _ x }} {{ f y _ }}` (the `_` are solved immediately, no need to declare them to elpi) ### API - New `coq.hints.opaque` - New `coq.hints.set-opaque` - Change load `coq.ltac.*` also in commands (and not just tactics) so that commands can easily turn holes into goals and inhabit them calling regular tactics. - New `coq.hints.add-resolve` - Fix `coq.option.add` survives the end of a file - New `coq.env.begin-module-functor` - New `coq.env.begin-module-type-functor` - New `coq.env.apply-module-functor` - New `coq.env.apply-module-type-functor` - New `coq.inline` with constructors `coq.inline.no`, `coq.inline.at` and `coq.inline.default` - New `@inline-at! N` and `@inline!` macros - Change `coq.env.add-axiom` honors `@inline` macros ## [1.12.1] - 20-01-2022 Requires Elpi 1.13.6 and Coq 8.15. ### APPS - `derive Inductive i {A}` now correctly sets `A` implicit status - `lock Definition f {A}` now correctly sets `A` implicit status ### API - New `coq.arity->implicits` - New `coq.indt-decl->implicits` - New `coq.any-implicit?` ## [1.12.0] - 15-01-2021 Requires Elpi 1.13.6 and Coq 8.15. ### HOAS - Change `{{ p x }}` is no more interpreted as a primitive projection even if `p` is the associated constant - New `{{ x.(p) }}` is interpreted as a primitive projection if `p` is a primitive projection - New `{{ x.(@p params) }}` is interpreted as a regular projection even if `p` is a primitive projection, since primitive projections don't have parameters and the user wrote some ### API - Fix globalization of `arity` inside a section - New `coq.option` type to access Coq's GOption system (Set/Unset vernaculars) - New `coq.option.add` - New `coq.option.get` - New `coq.option.set` - New `coq.option.available?` - New `coq.bind-ind-parameters` ### APPS - New `locker` app providing `lock` and `mlock` commands ## [1.11.2] - 24-09-2021 Requires Elpi 1.13.6 and Coq 8.14. ### API - Change `coq.bind-ind-arity` preserves `let` - New `coq.bind-ind-arity-no-let` to reduce `let`, used in `coq.build-match` - Fix `coq.build-match` putting `let` bindings in `match` return type - Change `coq.map-under-fun` preserves `let` ## [1.11.1] - 24-09-2021 Requires Elpi 1.13.6 and Coq 8.13. ### API - New `coq.env.informative?` to know if a type can be eliminated to build a term of sort `Type` - Fix `coq.warning` is synchronized with Coq's Undo machinery - Retire the venerable "elpi fails" message, replaced with something more precise inviting the user to report a bug: errors should be taken care of and reported nicely by the programmer. - New `coq.uint63->int` - New `coq.float64->float` - New `coq.ltac.id-free?` tells if a given ident is already used to denote a goal hypothesis, or not. ### Derive - Fix derivation of induction principles for "data types" in `Prop` - Add derivation of `param1` for the equality test `eq` with name `t.param1_eq` - Fix `invert` and `idx2inv` when dealing with containers - New datatypes from the Coq's prelude are derived in advance, no need to to `derive nat` anymore. ## [1.11.0] - 30-06-2021 Requires Elpi 1.13.6 and Coq 8.13. ### HOAS - New node `proj` of type `projection -> int -> primitive-value` holding the projection name (a Coq detail) and the number of the field it projects (0 based), eg: `primitive (proj _ N)` stands for the projection for the Nth constructor field counting parameters. - Change `cs-instance` carries a `gref` ### API - New `coq.notation.add-abbreviation-for-tactic` to add a parsing rule for a tactic-in-term, along the lines of `Notation foo := ltac:(elpi mytactic arguments)` but passing `mytactic` the correct `elpi.loc` of invocation. - New `@pplevel!` attribute to control outermost parentheses in `coq.term->pp` and similar - New `coq.hints.add-mode` like the `Hint Mode` vernacular - New `coq.hints.modes` - New `coq.TC.declare-class` - Deprecate `coq.env.const-opaque?` -> `coq.env.opaque?` - Deprecate `coq.env.const-primitive?` -> `coq.env.primitive?` - Deprecate `coq.CS.canonical-projections` -> `coq.env.projections` - New `coq.env.primitive-projections` - Change `coq.warning` emits the same warning only once ## [1.10.3] - 18-06-2021 Requires Elpi 1.13.6 and Coq 8.13. ### Lib - Cleanup `elpi.loc` attribute, which now carries a real loc and not a string. Thanks to elpi 1.13.6 we can project out the components without messing with regular expressions. Moreover loc are printed in a consistent way on Unix and Windows. ## [1.10.2] - 11-06-2021 Requires Elpi 1.13.5 and Coq 8.13. ### API - Change `coq.gref->path` now (consistently) gives the path without the final id, which can be retrieved by `coq.gref->id`. ## [1.10.1] - 24-05-2021 Requires Elpi 1.13.5 and Coq 8.13. ### HOAS - Fix (reverse) the order of the context argument of `goal`. The head of the list is the most recent hypothesis and in the last to be loaded (the one with higher precedence) by implication when one writes `Ctx => ...`. - New `msolve` entry point for (possibly multi goal) tactics ### API - Fix argument interpretation for `coq.ltac.call-ltac1`, the context is now the one of the goal alone (and not the one of the goal plus the current one) - Rename `coq.ltac.then` to `coq.ltac.all` ## [1.10.0] - 21-05-2021 Requires Elpi 1.13.5 and Coq 8.13. ### Derive - New `lens` and `lens_laws` for regular and primitive records with or without parameters - `derive` takes `#[only(this, that)]` to select the desired derivations ### API - Fix `coq.elpi.accumulate` scope `current`, which was putting the closes in the current module for the current file, but was making them global for the files importing it - New scope `library` for `coq.elpi.accumulate` which links the clauses to the library, that is the module named after the file. - Fix databases are always available, no need to import files in the right order when databases have named clauses. The error "Error: unable to graft this clause: no clause named ..." should no more be raised in response to a `Require Import`. - New `coq.strategy.*` to `set` and `get` the unfolding priority of constants followed by the term comparison algorithm Coq uses at type checking time. - New `coq.env.record?` to test if an inductive is a record and if it has primitive projections - New `coq.env.recursive?` to test if an inductive is recursive - Change `coq.locate*` understands strings like `"lib:some.name"` which point to global references registered via the Coq `Register` command - New `coq.ltac.fail` like `coq.error` but catch by Ltac - New `@ltacfail!` to be used like `@ltacfail! Level => std.assert! ...` in tactic code to use `coq.ltac.fail` instead of `coq.error` in case of failure - Change failure as is `elpi fails` (no more clauses to try) or `elpi run out of steps` are not considered Ltac failures anymore, but rather fatal errors. Add a clause `solve _ _ :- coq.ltac.fail _` to preserve the old behavior. - New `coq.ltac.collect-goals` to turn unresolved unification variables into goals. - Fix `coq.env.add-const` now accepts an opaque definition with no given type. The body is assumed to be well typed and is quickly retypechecked. ### HOAS - Fix handling of default case in `match`, now Coq's `if _ then _ else _` works just fine. - New quotation `{{:gref id }}` and `{{:gref lib:qualid }}` that unfolds to the `gref` data type (`{{ id }}` and `{{ lib:qualid }}` unfold to terms) - Change `solve` only takes 2 arguments (the arguments passed at tactic invocation time are now part of the goal) and the first argument is a single goal, not a list thereof. The second argument is now a `sealed-goal`. - Change `refine` now generates a list of `sealed-goal`s - Change `goal` now carries two unification variables standing for the raw solution to goal and the elaborated, well typed, one. Assigning a term to the raw variable triggers a call to `coq.elaborate-skeleton` which in turn assigns the other one to the (partial) proof term. Assigning the elaborated variable directly does not trigger a type check of the term. ### Vernacular - New `attributes` tactic argument (for `Tactic Notation`) - New `elpi tac` can receive attributes via the usual `#[stuff] tac` syntax - New syntax to pass Elpi tactics arguments coming from Ltac variables: - `ltac_string:(v)` (for `v` of type `string` or `ident`) - `ltac_int:(v)` (for `v` of type `int` or `integer`) - `ltac_term:(v)` (for `v` of type `constr` or `open_constr` or `uconstr` or `hyp`) - `ltac_(string|int|term)_list:(v)` (for `v` of type `list` of ...) - `ltac_attributes:(v)` (for `v` of type `attributes`) Example: ```coq Tactic Notation "foo" string(X) ident(Y) int(Z) constr(T) constr_list(L) := elpi foo ltac_string:(X) ltac_string:(T) ltac_int:(Z) (T) ltac_term_list(L). ``` lets one write `foo "a" b 3 nat t1 t2 t3` in any Ltac context. For attributes one has to place `ltac_attributes:(v)` in front of `elpi`, as in: ```coq Tactic Notation "foo" "#[" attributes(A) "]" := ltac_attributes:(A) elpi foo. ``` Here the delimiters `#[` and `]` are chosen for consistency, you can use any "delimited" syntax really. The usual prefix notation is also possible with the following limitations due to a parsing conflicts in the Coq grammar (at the time of writing): ```coq Tactic Notation "#[" attributes(A) "]" "tac" := ltac_attributes:(A) elpi tac. ``` - `#[ att ] tac.` does not parse - `(#[ att ] tac).` works - `idtac; #[ att ] tac.` works - Change `-qua.lid` is no more understood as the string `"-qua.lid"` but as two strings (when passed to a command, syntax error when passed to a tactic) ## [1.9.7] - 15-04-2021 Requires Elpi 1.13.1 and Coq 8.13. ### Vernacular - New attribute `#[skip="rex"]` and `#[only="rex"]` for the `Elpi Acumulate` family of commands which let one accumulate a piece of (compatibility) code only on some Coq versions. ## [1.9.6] - 13-04-2021 Requires Elpi 1.13.1 and Coq 8.13. ### API - New `coq.reduction.lazy.norm` - New `coq.reduction.native.norm` - New `coq.reduction.native.available?` - Rename `coq.reduction.cbv.whd_all` -> `coq.reduction.cbv.norm` - Rename `coq.reduction.vm.whd_all` -> `coq.reduction.vm.norm` ## [1.9.5] - 26-03-2021 Requires Elpi 1.13 and Coq 8.13. ### Vernacular - Commands, Tactics and Db cannot be declared inside sections or modules (it never really worked, but now you get an error message). - Clauses which are accumulated via `coq.elpi.accumulate` and are not `@local!` survive section closing if they don't mention the section variables being discharged. ### Typechecker - Warnings can be turned into errors by passing Coq `-w +elpi.typecheck`. ### API - New `coq.CS.db-for` to filter the CS db given a projection or a canonical value, or both. - New `coq.warning` like `coq.warn` but with a category and name, so that the message can be silenced or turned into an error. ## [1.9.4] - 17-03-2021 Requires Elpi 1.13 and Coq 8.13. ### Elpi - Calls to APIs that only read the global state are much faster (thousands of times faster) - Fix compilation with OCaml 4.12 ### API - Fix issue with `coq.env.add-abbreviation` when given a term with binders having overlapping `name`s. - New `copy-indt-decl` - New `coq.coercion.declare` is able to infer the endpoints if omitted ## [1.9.3] - 18-02-2021 Requires Elpi 1.13 and Coq 8.13. ### Elpi - Fix issue with async-mode (Elpi commands can change the parser) ### API - New `attmap` attribute type to represent associative maps over strings, eg `#[foo(x = "a", y = "b")]` ## [1.9.2] - 12-02-2021 Requires Elpi 1.13 and Coq 8.13. ### API - Fix `elpi.loc` computation when run in interactive mode. - New `@using! S` attribute for `coq.env.add-const` akin to Coq's `#[using=S]`. ## [1.9.1] - 11-02-2021 Requires Elpi 1.13 and Coq 8.13. ### API - Fix `coq.env.add-section-variable` and `coq.env.add-axiom` were not handling universes correctly. ### Build system - New target `build` which only builds elpi and the apps - New target `test` which runs all tests for elpi and the apps - OPAM package only calls `test` only if requested, hence the package typically installs faster ## [1.9.0] - 10-02-2021 Requires Elpi 1.13 and Coq 8.13. ### HOAS - Fix `coq.env.indt-decl` to generate a `record-decl` for records. ### Elpi - Fix issue with the compiler cache when used in async-mode (via CoqIDE or vscoq). ### API - New type `coq.pp` and `coq.pp.box` to describe Coq's pretty printer box model - New `coq.pp->string` to turn formatting boxes into a string - New `coq.term->pp` to turn formatting boxes into a string - New `@ppall!` attribute to print terms in full details - New `@ppmost!` attribute to print terms in a reparsable way - New `@ppwidth! N` attribute to specify the maximal line length when turning formatting boxes into strings - New `fold-map` to map a term with an accumulator - New `coq.env.add-section-variable` - New `coq.env.add-axiom` - Deprecate `coq.env.add-const` for declaring axioms or section variables. The deprecation warning is called `elpi.add-const-for-axiom-or-sectionvar` and can be turned into an error by passing to `coqc` the option `-w +elpi.add-const-for-axiom-or-sectionvar` ### Tooling - The `COQ_ELPI_ATTRIBUTES=text` parses `text` as Coq attributes `#[elpi(text)]` and passes them to all commands. Attributes in the `elpi.` namespace are silently ignored by commands not using them. - Attribute `elpi.loc` carries the `loc` of the command being run (if exported with `Elpi Export cmd`). This location does not comprise control flags (eg `Fail`, `Time`) nor attributes. This limitation will be lifted in Coq 8.14 (8.13 does not expose this parsing information to plugins). ## [1.8.1] - 11-12-2020 Requires Elpi 1.12 and Coq 8.13. ### HOAS - Illformed terms like `global (const X)` (which have no representation in Coq) are now reported with a proper error message. Whe passed to `coq.term->string`, instead of a fatal error, we pick for the illformed sub term the `unknown_gref` special constant. ## [1.8.0] - 29-11-2020 Requires Elpi 1.12 and Coq 8.12. ### API - New `@primitive!` attribute for `coq.env.add-indt` allowing one to declare primitive records. So far no term syntax for primitive projects is supported, their "non primitive" version is always used instead. ### HOAS - Best effort support for Coq's `let (x, y, .. ) := t in ` in quotations. ### API - Fix `coq.term->gref` skips over casts ## [1.7.0] - 26-11-2020 Requires Elpi 1.12 and Coq 8.12. ### HOAS - New `primitive (uint63 )` term constructor - New `primitive (float64 )` term constructor ### API - New `coq.reduction.lazy.whd_all` - New `coq.reduction.cbv.whd_all` - New `coq.reduction.vm.whd_all` - New `coq.env.const-primitive?` - Fix argument `const-decl` is accepted even if the name is "_", allowing one to write `Elpi command Definition _ : type := body` - Fix `coq.notation.abbreviation` gives an error if too few arguments are provided ### Sources Major reorganization of sources: - src/ is for .ml files - elpi/ for .elpi files - theories/ for .v files meant to be installed - tests/ for the test suite, not to be installed - examples/ for tests (not to be installed) Moreover the apps/ directory is for applications written in Coq-Elpi, their structure follows the same convention ### NES (Namespace Emulation System) - POC application emulating name spaces on top of modules ### Elpi integration - Use Elpi 1.12 API to implement a compiler cache and avoid recompiling over and over the same programs. ## [1.6.0] - 21-08-2020 Requires Elpi 1.11 and Coq 8.12. ### UIs - Display failures generated by `std.assert!` as errors ### Derive - Use the new `coq.elaborate-skeleton` API to insert coercions ### Fix - Embedding for sorts was incorrectly mapping `Prop` to `sprop` - `coq.env.add-const` made 8.12 friendly with a workaround for coq/coq#12759 ### API - New `coq.elaborate-skeleton` and `coq.elaborate-ty-skeleton` that run Coq's elaborator on a term obtained by disregarding evars and universes in the given input. Unfortunately Coq's elaborator does not take terms as input, but glob terms, and the conversion function is not lossless. See also `lib:elpi.hole`. - New `coq.elaborate-indt-decl-skeleton` to elaborate an inductive type declaration. - New `coq.elaborate-arity-skeleton` to elaborate an arity. - New `coq.env.current-path` to get the current module path. - New `coq.modpath->path` and `coq.modpath->path` to get access to the components of a module path. - Change `coq.elpi.accumulate` understands the `@local!` attribute, which makes the clauses `Local` to the module into which they live. ### HOAS - New `lib:elpi.hole` constant that can be used in place of a unification variable to denote an implicit argument when calling `coq.*-skeleton` APIs ## [1.5.1] - 29-07-2020 Requires Elpi 1.11 and Coq 8.12. ### API: Locality is now supported by `coq.CS.declare-instance` ## [1.5.0] - 29-07-2020 Requires Elpi 1.11 and Coq 8.11. ### HOAS - New option `@holes!` to be assumed (as in `@holes! => ...`) before calling any Coq API. When this option is given unknown unification variables are interpreted as "implicit arguments" (linear holes that see all the variables in scope). If the unification variable is outside the pattern fragment the following heuristic is applied: arguments that are not variables are heuristically dropped; arguments which are variables but occur multiple times are kept only once (the first occurrence is kept, the others are dropped). ### API - New `coq.arguments.set-default-implicit` that behaves like `Arguments foo : default implicits` - Change of arguments of type `@global?` attributes `@local!` or `@global!`. In order to pass a locality directive one has to do something like `@global! => coq.add-something` Locality is understood by: - `coq.TC.declare-instance` - `coq.coercion.declare` - `coq.arguments.set-implicit` - `coq.arguments.set-default-implicit` - `coq.arguments.set-name` - `coq.arguments.set-scope` - `coq.arguments.set-simplification` - `coq.notation.add-abbreviation` - `coq.env.add-const` - Change of argument for deprecation to attribute `@deprecated! Since Message`. In order to pass a deprecation directive one has to do something like `@deprecated! "8.11.0" "use this instead" => coq.add-something` Deprecation is understood by: - `coq.notation.add-abbreviation` - New macro `@transparent!` with value `ff` to be used with `coq.env.add-const` ### Elaborator - `engine/elaborator.elpi` is now installed (but not used by default). One can `Elpi Accumulate "engine/elaborator.elpi".` in order to load it. It is too experimental to use it in production, but it is also hard to experiment with it without having it installed. ### CI - Switch to Github Actions and Coq Community's Docker workflow ### Bugfix - anonymous record fields are not given a generated name anymore - `coq.typecheck` and `coq.typecheck-ty` API now ensure that all unification problems required by type checking are actually solved by Coq's unifier - some debug printings used to raise errors in corner cases, now fixed ## [1.4.1] - 2020-06-10 Minor fixes - Missing opaque data type declaration for `abbreviation` (could lead to confusing type errors) - Parse also "keywords" where `qualified_name` is expected. `Elpi Export x.` turns `x` into a keyword, and that used to break commands `Elpi Something x ...`. Parsing of all commands is now resilient to this. ## [1.4.0] - 2020-05-19 Requires Elpi 1.11 and Coq 8.11 or 8.12. The main visible change is the `indt-decl` data type that now faithfully represents an inductive type declaration (including the implicit status of parameters). Also all the predicates implemented in `coq-lib` are now in the `coq.` namespace. ### API - New `coq.notation.abbreviation-body` to retrieve the number of arguments and body of a syntactic definition. - New `coq.id->name` to convert a relevant id into an irrelevant pretty printing hint. - New `coq.mk-n-holes ` to produce a list of flexible terms. - New `coq.env.indt-decl` to read for the environment an inductive type represented in HOAS form - `coq.env.indt->decl` renamed `coq.build-indt-decl` - New `coq.env.rename-indt-decl` - Change `coq.env.add-indt` now sets the imlicit status of the inductive type and its constructors (since the `parameter` constructor can carry it) - New `coq.arity->nparams` to count the number of parameters - Change `parse-attributes` made deterministic - Change `coq.unify-leq` and `coq.unify-eq` now return a diagnostic - Change `subst-prod` -> `coq.subst-prod` - Change `subst-fun` -> `coq.subst-fun` - Change `prod->fun` -> `coq.prod->fun` - Change `count-prods` -> `coq.count-prods` - Change `prod-R-fun` -> `coq.prod-R-fun` - Change `safe-dest-app` -> `coq.safe-dest-app` - Change `arity->sort` -> `coq.arity->sort` - Change `term->gref` -> `coq.term->gref` - Change `fresh-type` -> `coq.fresh-type` - Change `build-match` -> `coq.build-match` - Change `map-under-fun` -> `coq.map-under-fun` - Change `iter-under-fun` -> `coq.iter-under-fun` - Change `bind-ind-arity` -> `coq.bind-ind-arity` - Change `with-TC` -> `coq.with-TC` - Change `valid-attribute` -> `coq.valid-attribute` - Change `is-one-of` -> `coq.is-one-of` - Change `parse-attributes` -> `coq.parse-attributes` - Change `mk-app` -> `coq.mk-app` - Change `mk-app-uvar` -> `coq.mk-app-uvar` - Change `mk-eta` -> `coq.mk-eta` ### Universes - New support for `Type@{name}` in Coq `{{ quotations }}`. - Fix more precise promotion of universe variables to universe global names in builtins changing the Coq environment (eg `coq.env.add-const`). - New user error when `coq.elpi.accumulate` is given a clause that mentions universe variables: only global universes can be stored in a DB. ### HOAS - Change `indt-decl`: - the `parameter` constructor carries an `id`, `imlpicit_kind` and a type - the `coinductive` constructor was removed, the `inductive` one carries a `bool`, `tt` for inductive, `ff` for coinductive - the `inductive` constructor no more carries the number of non uniform parameters, and the inductive type arity (see below) is no more a simple term but rather an `arity` (all its parameters are non uniform) - the `constructor` constructor now carries an `arity` so that non uniform parameters can be represented faitfully - New `arity` data type, constructors are `parameter` (shared with `indt-decl`) and `arity`. - New `indt-decl` argument type introduced in version 1.3 now supports the syntax of inductive types (not just records). Eg `Elpi command Inductive P {A} t : I := | K1 .. | K2 ..`. - Change `context-item` now carries an `id` and an `implicit-kind` - Change `const-decl` now carries an arity to describe the parameters of the definition in a faithful way - New `@pi-parameter ID Ty p\ ...` to postulate a nominal `p` with type `Ty` and a name built out of the id `ID` ### Derive - New derivations `derive.invert` and `derive.idx2inv` now called by `derive` - New global command `derive` taking in input the name of an inductive or an inductive declaration. In the latter case all derivations are placed in a module named after the inductive ## [1.3.1] - 2020-03-01 Port to Coq 8.11, two API changes: - `field` constructor of `indt-decl` takes an argument of type `field-attributes` rather than a simple `bool`. The macro `@coercion!` works in both versions, as well as omitting the attribute using `_`. In 8.11 it is possible to disable canonical inference for a field using the `(canonical false)` attribute. - `coq.env.add-abbreviation` takes an extra argument (deprecation info). Code working on both versions can be obtained as follows: ```prolog if (coq.version _ 8 10 _) (std.unsafe-cast coq.notation.add-abbreviation F, F ... Abbrev) (std.unsafe-cast coq.notation.add-abbreviation G, G ... Deprecation Abbrev). ``` ## [1.3.0] - 2020-02-27 Requires Elpi 1.10 and Coq 8.10 or 8.11. The main visible change is that opaque data types such as `@constructor`, `@inductive` and `@constant` are now written without the `@`, since Elpi now supports the `typeabbrev` directive. The main invisible change is that code accumulated into commands and tactics is "compiled" by Elpi once and forall in the context in which it is accumulated. As a consequence Coq code inside `{{quotations}}` is processed in that, and only that, context of notations, scopes, etc. Data bases are compiled every time it is needed in the current Coq context, hence quotations should be used with care. The file `coq-HOAS.elpi` is now distributed as part of `coq-builtin.elpi`. ### Vernacular - New `Elpi Export command` to make `command` available without the `Elpi` prefix. - `Elpi command` (exported or not) can now access Coq's attributes (the `#[option]` thing). See the HOAS section below. - Coq keywords or symbols passed to command and tactics are interpreted as strings even if not quoted. Eg `Elpi command =>` is the same of `Elpi command "=>"`. - The identifiers `Record`, `Definition`, `Axioms` and `Context` are now reserved (see the HOAS section below). In order to pass them (as strings) one has to quote them. ### APIs - New `coq.typecheck-ty` to typecheck a type (outputs a universe) - New `coq.env.import/export-module`. - New `coq.env.begin/end-section`. - New `coq.notation.abbreviation` to unfold an abbreviation. - New `coq.locate-abbreviation` to locate abbreviations. - New `coq.locate-any` that never fails and gives a list of possible interpretations (term, abbreviation, module, module type). - Rename `coq.env.typeof-gr` to `coq.env.typeof`. - Rename `term->gr` to `germ->gref`. - Rename `coq.gr->*` to `coq.gref->*string*` - Change `coq.typecheck` and `coq.typecheck-indt-decl` so that they never fail and have a 3rd argument of type `diagnostic` (from Elpi 1.9) to signal success or errors (that can be printed). - Change `coq.elpi.accumulate` so that one can put the clause either in current module from which the program is started, or in the current module while the program runs (which can be different if one uses the `coq.env.begin-module` API). - Remove `coq.elaborate` and `coq.elaborate-indt-decl`. - Fix `coq.typecheck T TY` to uses Coq's unification to equate the type inferred for `T` and `TY` (when it is provided by the user). - Fix `coq.CS.*` w.r.t. default instances of canonical structures. - Fix all APIs changing the Coq global state to abort if they are used from a tactic. - Fix `coq.gr->string` to not duplicate the label part of the name ### HOAS - Change context entry `def` to not carry a cache for the normal form of the defined term (now cached by a specific `cache` context entry). `def` now carries the exact same information of a `let`, as `decl` carries the same information of a `fun`. - New `indt-decl` argument type with a concrete syntax that mimics the standard one for records. Eg `Elpi command Record x := K { f : T }`. - New `const-decl` argument type with a concrete syntax that mimics the standard one for definitions or axioms. Eg `Elpi command Definition x := t.`. - New `ctx-decl` argument type with a concrete syntax that mimics the standard one for contexts. Eg `Elpi command Context T (x : T).`. - Add to the context under which `main` is run the list of attributes passed to the command invocation (Coq syntax is for example `#[myflag]`). See the `attribute-value` data type in `coq-builtin.elpi` and `parse-attributes` helper in `coq-lib.elpi`. ## [1.2.0] - 2019-10-30 ### APIs - New `coq.gr->path` to get the path components as a list of strings - Failure of `coq.ltac.call` is now turned into logical failure, as any other Elpi tactic - Fix `coq.end.add-indt` in the case of record (was not flagging the inductive as such) - Fix `coq.version`, wrong parsing of beta versions - Expose `set` and `map` from Elpi 1.8 (generic data structure for ground terms) ### Documentation - Improve reflexive tactic demo - Fix documentation of `coq.gr->*` APIs - `coq-HOAS.elpi`, `coq-lib.elpi` and `coq-builtin.elpi` are now installed since they provide useful doc (but are not needed by the runtime, since they are embedded in `elpi.vo`) ## [1.1.0] - 2019-10-10 ### derive.param2 - interface made consistent with other derivations: `derive.param2` takes in input optional suffix, instead of the full name of the derived concept - storage of previous derivations based on Elpi Db - the derivation generates nicer types for relators over fixpoints (the new types are convertible to the old ones, but the fixpoint is not expanded). PR [#84](https://github.com/LPCIC/coq-elpi/pull/84/) by Cyril Cohen ### Documentation - Improved documentation of `coq.typecheck` ## [1.0.0] - 2019-10-09 - First public release coq-elpi-1.19.3/LICENSE000066400000000000000000000635351451177652200143510ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. (This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.) Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. {description} Copyright (C) {year} {fullname} This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. {signature of Ty Coon}, 1 April 1990 Ty Coon, President of Vice That's all there is to it! coq-elpi-1.19.3/Makefile000066400000000000000000000110411451177652200147650ustar00rootroot00000000000000 # detection of coq ifeq "$(COQBIN)" "" COQBIN := $(shell which coqc >/dev/null 2>&1 && dirname `which coqc`) endif ifeq "$(COQBIN)" "" $(error Coq not found, make sure it is installed in your PATH or set COQBIN) else $(info Using coq found in $(COQBIN), from COQBIN or PATH) endif export COQBIN := $(COQBIN)/ # detection of elpi ifeq "$(ELPIDIR)" "" ELPIDIR=$(shell ocamlfind query elpi 2>/dev/null) endif ifeq "$(ELPIDIR)" "" $(error Elpi not found, make sure it is installed in your PATH or set ELPIDIR) endif export ELPIDIR DEPS=$(ELPIDIR)/elpi.cmxa $(ELPIDIR)/elpi.cma APPS=$(addprefix apps/, derive eltac NES locker coercion) ifeq "$(COQ_ELPI_ALREADY_INSTALLED)" "" DOCDEP=build else DOCDEP= endif ifndef DOCDIR DOCDIR=$(shell $(COQBIN)/coqc -where)/../../share/doc/coq-elpi endif ifndef COQDOCINSTALL COQDOCINSTALL=$(DESTDIR)$(DOCDIR) endif all: $(MAKE) build-core $(MAKE) test-core $(MAKE) examples $(MAKE) build-apps $(MAKE) test-apps build-core: Makefile.coq $(DEPS) @echo "########################## building plugin ##########################" @if [ -x $(COQBIN)/coqtop.byte ]; then \ $(MAKE) --no-print-directory -f Makefile.coq bytefiles; \ fi @$(MAKE) --no-print-directory -f Makefile.coq opt build-apps: build-core @echo "########################## building APPS ############################" @$(foreach app,$(APPS),$(MAKE) -C $(app) build &&) true build: build-core build-apps test-core: Makefile.test.coq $(DEPS) build-core @echo "########################## testing plugin ##########################" @$(MAKE) --no-print-directory -f Makefile.test.coq test-apps: build-apps @echo "########################## testing APPS ############################" @$(foreach app,$(APPS),$(MAKE) -C $(app) test &&) true test: test-core test-apps examples: Makefile.examples.coq $(DEPS) build-core @echo "############################ examples ############################" @$(MAKE) --no-print-directory -f Makefile.examples.coq doc: $(DOCDEP) @echo "########################## generating doc ##########################" @mkdir -p doc @$(foreach tut,$(wildcard examples/tutorial*$(ONLY)*.v),\ echo ALECTRYON $(tut) && ./etc/alectryon_elpi.py \ --frontend coq+rst \ --output-directory doc \ --pygments-style vs \ -R theories elpi -Q src elpi \ $(tut) &&) true @cp stlc.html doc/ @cp etc/tracer.png doc/ .merlin: force @rm -f .merlin @$(MAKE) --no-print-directory -f Makefile.coq $@ .PHONY: force build all test doc Makefile.coq Makefile.coq.conf: src/coq_elpi_builtins_HOAS.ml src/coq_elpi_config.ml _CoqProject @$(COQBIN)/coq_makefile -f _CoqProject -o Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq .merlin Makefile.test.coq Makefile.test.coq.conf: _CoqProject.test @$(COQBIN)/coq_makefile -f _CoqProject.test -o Makefile.test.coq Makefile.examples.coq Makefile.examples.coq.conf: _CoqProject.examples @$(COQBIN)/coq_makefile -f _CoqProject.examples -o Makefile.examples.coq src/coq_elpi_builtins_HOAS.ml: elpi/coq-HOAS.elpi Makefile.coq.local echo "(* Automatically generated from $<, don't edit *)" > $@ echo "(* Regenerate via 'make $@' *)" >> $@ echo "let code = {|" >> $@ cat $< >> $@ echo "|}" >> $@ src/coq_elpi_config.ml: echo "let elpi_dir = \"$(abspath $(ELPIDIR))\";;" > $@ clean: Makefile.coq Makefile.test.coq @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ @$(foreach app,$(APPS),$(MAKE) -C $(app) $@ &&) true include Makefile.coq.conf V_FILES_TO_INSTALL := \ $(filter-out theories/wip/%.v,\ $(COQMF_VFILES)) install: @echo "########################## installing plugin ############################" @$(MAKE) -f Makefile.coq $@ VFILES="$(V_FILES_TO_INSTALL)" @if [ -x $(COQBIN)/coqtop.byte ]; then \ $(MAKE) -f Makefile.coq $@-byte VFILES="$(V_FILES_TO_INSTALL)"; \ fi -cp etc/coq-elpi.lang $(COQMF_COQLIB)/ide/ @echo "########################## installing APPS ############################" @$(foreach app,$(APPS),$(MAKE) -C $(app) $@ &&) true @echo "########################## installing doc ############################" -mkdir -p $(COQDOCINSTALL) -cp doc/* $(COQDOCINSTALL) @echo "########################## installed ############################" # compile just one file theories/%.vo: force @$(MAKE) --no-print-directory -f Makefile.coq $@ tests/%.vo: force build-core Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ examples/%.vo: force build-core Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ SPACE=$(XXX) $(YYY) apps/%.vo: force @$(MAKE) -C apps/$(word 1,$(subst /, ,$*)) \ $(subst $(SPACE),/,$(wordlist 2,99,$(subst /, ,$*))).vo coq-elpi-1.19.3/Makefile.coq.local000066400000000000000000000012421451177652200166410ustar00rootroot00000000000000CAMLPKGS+= -package elpi,stdlib-shims CAMLFLAGS+= -bin-annot -g OCAMLWARN+=-warn-error -32 COQEXTRAFLAGS=-bt theories/elpi.vo: $(wildcard elpi/*.elpi) merlin-hook:: echo "S $(abspath $(ELPIDIR))" >> .merlin echo "B $(abspath $(ELPIDIR))" >> .merlin if [ "$(ELPIDIR)" != "elpi/findlib/elpi" ]; then\ echo "PKG elpi" >> .merlin;\ fi install-extra:: df="`$(COQMKFILE) -destination-of theories/elpi.vo $(COQLIBS)`";\ install -m 0644 elpi-builtin.elpi "$(COQLIBINSTALL)/$$df";\ install -m 0644 coq-builtin.elpi "$(COQLIBINSTALL)/$$df";\ install -m 0644 elpi/coq-lib.elpi "$(COQLIBINSTALL)/$$df";\ install -m 0644 elpi/elpi_elaborator.elpi "$(COQLIBINSTALL)/$$df" coq-elpi-1.19.3/Makefile.release000066400000000000000000000007771451177652200164220ustar00rootroot00000000000000OPAM_SUITE=released TAG=$(shell git tag --sort=-v:refname|head -1) release: echo "Publishing tag $(TAG) in suite $(OPAM_SUITE)" echo "Hit ^C to stop, or type options (eg -n fro dry run) and return to continue:";\ read OPTS;\ TAG=$(TAG);\ opam-publish --tag=$(TAG) --packages-directory=$(OPAM_SUITE)/packages \ --repo=coq/opam --no-browser -v $${TAG##v} $$OPTS \ https://github.com/LPCIC/coq-elpi/releases/download/$$TAG/coq-elpi-$${TAG##v}.tar.gz release-rc: OPAM_SUITE=extra-dev release-rc: release coq-elpi-1.19.3/Makefile.test.coq.local000066400000000000000000000025571451177652200176310ustar00rootroot00000000000000tests/test_cache_async.vo: COQEXTRAFLAGS=-async-proofs on tests/test_COQ_ELPI_ATTRIBUTES.vo: export COQ_ELPI_ATTRIBUTES=test=yes,str="some-string" define test_link @F="$(1)";\ L1=`grep -n '^p 7\.' $$F | cut -d : -f 1`;\ L2=`grep -n '^p 2\.' $$F | cut -d : -f 1`;\ [ "$$L1" -gt "$$L2" ] || (echo "wrong link order in file $$F"; exit 1);\ for i in `seq 1 10`; do\ N=`grep "^p $$i\\\\." $$F | wc -l`;\ [ "$$N" = "1" ] || (echo "wrong linking: rule p $$i occurs $$N in file $$F"; exit 1);\ done;\ true endef post-all:: tests/test_glob.glob @echo "test coqdoc hyperlinks" @mkdir -p tests/test_glob/ @N=`coqdoc -d tests/test_glob -R tests elpi.tests tests/test_glob.v 2>&1 | grep -i warning | wc -l`;\ test $$N = 0 @echo "test link order" @diff -u tests/test_link_order1.txt tests/test_link_order2.txt @diff -u tests/test_link_order1.txt tests/test_link_order3.txt @diff -u tests/test_link_order1.txt tests/test_link_order4.txt @diff -u tests/test_link_order1.txt tests/test_link_order5.txt @diff -u tests/test_link_order1.txt tests/test_link_order6.txt @diff -u tests/test_link_order1.txt tests/test_link_order7.txt @diff -u tests/test_link_order1.txt tests/test_link_order8.txt @diff -u tests/test_link_order1.txt tests/test_link_order9.txt $(call test_link, tests/test_link_order1.txt) @diff -u tests/test_link_order_import3.ref tests/test_link_order_import3.txtcoq-elpi-1.19.3/README.md000066400000000000000000000464061451177652200146210ustar00rootroot00000000000000[![Actions Status](https://github.com/LPCIC/coq-elpi/workflows/CI/badge.svg)](https://github.com/LPCIC/coq-elpi/actions) [![project chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://coq.zulipchat.com/#narrow/stream/253928-Elpi-users.20.26.20devs) Coq-Elpi logo # Coq-Elpi [Coq](https://github.com/coq/coq) plugin embedding [Elpi](https://github.com/LPCIC/elpi). ## What is Elpi [Elpi](https://github.com/LPCIC/elpi) provides an easy-to-embed implementation of a dialect of λProlog, a programming language well suited to manipulate abstract syntax trees containing binders and unification variables. ## What is Coq-Elpi Coq-Elpi provides a Coq plugin that lets one define new commands and tactics in Elpi. For that purpose it provides an embedding of Coq's terms into λProlog using the Higher-Order Abstract Syntax approach ([HOAS](https://en.wikipedia.org/wiki/Higher-order_abstract_syntax)). It also exports to Elpi a comprehensive set of Coq's primitives, so that one can print a message, access the environment of theorems and data types, define a new constant, declare implicit arguments, type classes instances, and so on. For convenience it also provides quotations and anti-quotations for Coq's syntax, so that one can write `{{ nat -> lp:X }}` in the middle of a λProlog program instead of the equivalent AST. ## What is the purpose of all that In the short term, provide an extension language for Coq well suited to manipulate terms containing binders. One can already use Elpi to implement commands and tactics. As ongoing research we are looking forward to express algorithms like higher order unification and type inference, and to provide an alternative elaborator for Coq. ## Installation The simplest way is to use [OPAM](http://opam.ocaml.org/) and type ``` opam repo add coq-released https://coq.inria.fr/opam/released opam install coq-elpi ``` ### Editor Setup The recommended user interface is [VSCoq](https://github.com/coq-community/vscoq/). We provide an [extension for vscode](https://github.com/LPCIC/coq-elpi-lang) in the market place, just look for Coq Elpi. The extension provides syntax hilighting for both languages even when they are nested via quotations and antiquotations.
Other editors (click to expand)

At the time of writing Proof General does not handle quotations correctly, see ProofGeneral/PG#437. In particular `Elpi Accumulate lp:{{ .... }}.` is used in tutorials to mix Coq and Elpi code without escaping. Coq-Elpi also accepts `Elpi Accumulate " .... ".` but strings part of the Elpi code needs to be escaped. Finally, for non-tutorial material, one can always put the code in an external file declared with `From some.load.path Extra Dependency "filename" as f.` and use `Elpi Accumulate File f.`. CoqIDE does handle quotations. The installation process puts [coq-elpi.lang](etc/coq-elpi.lang) in a place where CoqIDE can find it. Then you can select `coq-elpi` from the menu `Edit -> Preferences -> Colors`. For Vim users, [Coqtail](https://github.com/whonore/Coqtail) provides syntax highlighting and handles quotations.

Development version (click to expand)

To install the development version one can type ``` opam pin add coq-elpi https://github.com/LPCIC/coq-elpi.git ``` One can also clone this repository and type `make`, but check you have all the dependencies installed first (see [coq-elpi.opam](coq-elpi.opam)). We recommend to look at the [CI setup](.github/workflows) for ocaml versions being tested. Also, we recommend to install `dot-merlin-reader` and `ocaml-lsp-server` (version 1.15).

## Documentation ### Tutorials - [The Elpi programming language](https://lpcic.github.io/coq-elpi/tutorial_elpi_lang.html) is an Elpi tutorial, there is nothing Coq specific in there even if the tutorial uses Coq to step trough the various examples. If you never heard of λProlog or HOAS based languages (like Twelf or Beluga) then you are strongly encouraged to read this tutorial and have a look at [λProlog's home page](http://www.lix.polytechnique.fr/Labo/Dale.Miller/lProlog/) for additional documentation. Even if you are familiar with λProlog or HOAS it may be worth reading the last sections since they focus on Elpi specific features. Last but not least it covers common pitfalls for people with a background in functional programming and the tracing mechanisms (useful for debugging). - [HOAS of Coq terms](https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_HOAS.html) focuses on how Coq terms are represented in Elpi, how to inspect them and call Coq APIs under a context of binders, and finally how holes ("evars" in Coq slang) are represented. It assumes the reader is familiar with Elpi. - [Writing commands in Elpi](https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_command.html) focuses on how to write commands, in particular how to store a state across calls via so called DBs and how to handled command arguments. It assumes the reader is familiar with Elpi and the HOAS of Coq terms. - [Writing tactics in Elpi](https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_tactic.html) describes how goals and tactics are represented, how to handle tactic arguments and finally how to define tactic notations. It assumes the reader is familiar with Elpi and the HOAS of Coq terms. - [Coq-Elpi in 20 minutes](https://youtu.be/m60rHnvCJ2o) video recording of a talk given at the Coq Users and Developers Workshop 2020. ### Small examples (proofs of concept) - [reification](examples/example_reflexive_tactic.v) is the typical use case for meta programs: reading the syntax of terms into an inductive representing a sub language on which some decision procedure can be implemented - [data bases](examples/example_data_base.v) shows how Elpi programs can store data and reuse it across multiple runs - [record expansion](examples/example_record_expansion.v) sketches a program to unpack records in a definition: it replaces an abstraction over a records with abstractions over all of its components - [record to sigma](examples/example_record_to_sigma.v) sketches a program that de-sugars a record type to iterated sigma types - [fuzzer](examples/example_fuzzer.v) sketches a program to alter an inductive type while preserving its well typedness. It makes nothing useful per se, but shows how to map a term and call the type checker deep inside it. - [tactics](examples/example_curry_howard_tactics.v) show how to create simple tactics by using (proof) terms and the elaborator of Coq - [generalize](examples/example_generalize.v) show how to abstract subterms out (one way to skin the cat, there are many) - [abs_evars](examples/example_abs_evars.v) show how to close a term containing holes (evars) with binders - [record import](examples/example_import_projections.v) gives short names to record projections applied to the given record instance. - [reduction surgery](examples/example_reduction_surgery.v) implements a tactic fine tuning cbv with a list of allowed unfoldings taken from a module. ### Applications written in Coq-Elpi - [Derive](apps/derive/examples/usage.v) shows how to obtain proved equality tests and a few extra gadgets out of inductive type declarations. See the [README](apps/derive/README.md) for the list of derivations. It comes bundled with Coq-Elpi. - [Locker](apps/locker) lets one hide the computational contents of definitions via modules or opaque locks. It comes bundled with Coq-Elpi. - [Hierarchy Builder](https://github.com/math-comp/hierarchy-builder) is a Coq extension to declare hierarchies of algebraic structures. - [Algebra Tactics](https://github.com/math-comp/algebra-tactics/) is a port of the `ring` and `field` tactics to the Mathematical Components library. - [Trakt](https://github.com/ecranceMERCE/trakt) is a generic goal preprocessing tool for proof automation tactics in Coq. - [Namespace Emulation System](apps/NES/examples/usage_NES.v) implements most of the features of namespaces (on top of Coq's modules). - [Dx](https://gitlab.univ-lille.fr/samuel.hym/dx) uses elpi to generate an intermediate representation of Coq terms, to be later tranformed into C. - [Coercion](apps/coercion) enable to program coercions in Elpi. It comes bundled with Coq-Elpi. ### Quick Reference In order to load Coq-Elpi use `From elpi Require Import elpi`. #### Vernacular commands
(click to expand) - `Elpi Command ` creates command named `` containing the preamble [elpi-command](elpi/elpi-command-template.elpi). - `Elpi Tactic ` creates a tactic `` containing the preamble [elpi-tactic](elpi/elpi-tactic-template.elpi). - `Elpi Db ` creates a Db (a program that is accumulated into other programs). `` is the initial contents of the Db, including the type declaration of its constituting predicates. - `Elpi Program ` lower level primitive letting one crate a command/tactic with a custom preamble ``. - `Elpi Accumulate [] [|File From |Db ]` adds code to the current program (or `` if specified). The code can be verbatim, from a file or a Db. It understands the `#[skip="rex"]` and `#[only="rex"]` which make the command a no op if the Coq version is matched (or not) by the given regular expression. File names are relative to the directory mapped to ``; if more than one such directory exists, the `` must exists only once. - `Elpi Typecheck []` typechecks the current program (or `` if specified). - `Elpi Debug ` sets the variable ``, relevant for conditional clause compilation (the `:if VARIABLE` clause attribute). - `Elpi Trace [[ ] *|Off]` enable/disable tracing, eventually limiting it to a specific range of execution steps or predicate names. - `Elpi Bound Steps ` limits the number of steps an Elpi program can make. - `Elpi Print [ *]` prints the program `` to an HTML file named `.html` and a text file called `.txt` (or `` if provided) filtering out clauses whose file or clause-name matches ``. where: - `` is a qualified Coq name, e.g. `derive.eq` or `my_program`. - `` is like `` but lives in a different namespace. By convention `` ends in `.db`, e.g. `derive.eq.db`. - `` is verbatim Elpi code, either `lp:{{ ... }}` or `" ... "` (in the latter case, strings delimiters need to be escaped following Coq rules, e.g. `lp:{{ coq.say "hello!" }}` becomes `" coq.say ""hello!"" "`). - `` is a string containing the path of an external file, e.g. `"this_file.elpi"`. - `` and `` are numbers, e.g. `17 24`. - `` is a regexp against which the predicate name is matched, e.g. `"derive.*"`.

#### Invocation of Elpi code
(click to expand) - `Elpi *.` invokes the `main` predicate of the `` program passing a possible empty list of arguments. This is how you invoke a command. - `elpi *.` invokes the `solve` predicate of the `` program passing a possible empty list of arguments and the current goal. This is how you invoke a tactic. - `Elpi Export ` makes it possible to invoke command `` without the `Elpi` prefix or invoke tactic `` in the middle of a term just writing ` args` instead of `ltac:(elpi args)`. Note that in the case of tactics, all arguments are considered to be terms. Moreover, remember that one can use `Tactic Notation` to give the tactic a better syntax and a shorter name when used in the middle of a proof script. where `` can be: - a number, e.g. `3`, represented in Elpi as `(int 3)` - a string, e.g. `"foo"` or `bar.baz`, represented in Elpi as `(str "foo")` and `(str "bar.baz")`. Coq keywords and symbols are recognized as strings, eg `=>` requires no quotes. Quotes are necessary if the string contains a space or a character that is not accepted for qualified identifiers or if the string is `Definition`, `Axiom`, `Record`, `Structure`, `Inductive`, `CoInductive`, `Variant` or `Context`. - a term, e.g. `(3)` or `(f x)`, represented in Elpi as `(trm ...)`. Note that terms always require parentheses, that is `3` is a number while `(3)` is a Coq term and depending on the context could be a natural number (i.e. `S (S (S O))`) or a `Z` or ... See also the section Terms as arguments down below, and the syntax for Ltac variables down below. Commands also accept the following arguments (the syntax is as close as possible to the Coq one: [...] means optional, * means 0 or more). See the `argument` data type in `coq-builtin.elpi` for their HOAS encoding. See also the section Terms as arguments down below. - `Definition` _name_ _binder_* [`:` _term_] `:=` _term_ - `Axiom` _name_ `:` _term_ - [ `Record` | `Structure` ] _name_ _binder_* [`:` _sort_] `:=` [_name_] `{` _name_ `:` _term_ `;` * `}` - [ `Inductive` | `CoInductive` | `Variant` ] _name_ _binder_* [`|` _binder_*] [`:` _term_] `:=` `|` _name_ _binder_* `:` _term_ * - `Context` _binder_* ##### Ltac Variables Tactics also accept Ltac variables as follows: - `ltac_string:(v)` (for `v` of type `string` or `ident`) - `ltac_int:(v)` (for `v` of type `int` or `integer`) - `ltac_term:(v)` (for `v` of type `constr` or `open_constr` or `uconstr` or `hyp`) - `ltac_(string|int|term)_list:(v)` (for `v` of type `list` of ...) - `ltac_tactic:(t)` (for `t` of type `tactic_expr`) - `ltac_attributes:(v)` (for `v` of type `attributes`) For example: ```coq Tactic Notation "tac" string(X) ident(Y) int(Z) hyp(T) constr_list(L) simple_intropattern_list(P) := elpi tac ltac_string:(X) ltac_string:(Y) ltac_int:(Z) ltac_term:(T) ltac_term_list:(L) ltac_tactic:(intros P). ``` lets one write `tac "a" b 3 H t1 t2 t3 [|m]` in any Ltac context. Arguments are first interpreted by Ltac according to the types declared in the tactic notation and then injected in the corresponding Elpi argument. For example `H` must be an existing hypothesis, since it is typed with the `hyp` Ltac type, but in Elpi it will appear as a term, eg `trm c0`. Similarly `t1`, `t2` and `t3` are checked to be well typed and to contain no unresolved implicit arguments, since this is what the `constr` Ltac type means If they were typed as `open_constr` or `uconstr`, the last or both checks would be respectively skipped. In any case they are passed to the Elpi code as `trm ...`. Both `"a"` and `b` are passed to Elpi as `str ...`. Finally, `ltac_term:(T)` and `(T)` are *not* synonyms: but the former must be used when defining tactic notations, the latter when invoking elpi tactics directly. ##### Attributes Attributes are supported in both commands and tactics. Examples: - `#[ att ] Elpi cmd` - `#[ att ] cmd` for a command `cmd` exported via `Elpi Export cmd` - `#[ att ] elpi tac` - `Tactic Notation ... attributes(A) ... := ltac_attributes:(A) elpi tac`. Due to a parsing conflict in Coq grammar, at the time of writing this code: ```coq Tactic Notation "#[" attributes(A) "]" "tac" := ltac_attributes:(A) elpi tac. ``` has the following limitation: - `#[ att ] tac.` does not parse - `(#[ att ] tac).` works - `idtac; #[ att ] tac.` works ##### Terms as arguments Since version 1.15, terms passed to Elpi commands code via `(term)` or via a declaration (like `Record`, `Inductive` ...) are in elaborated format by default. This means that all Coq notational facilities are available, like deep pattern matching, or tactics in terms. One can use the attribute `#[arguments(raw)]` to declare a command which instead takes arguments in raw format. In that case, notations are unfolded, implicit arguments are expanded (holes `_` are added) and lexical analysis is performed (global names and bound names are identified, holes are applied to bound names in scope), but deep pattern matching or tactics in terms are not supported, and in particular type checking/inference is not performed. Once can use the `coq.typecheck` or `coq.elaborate-skeleton` APIs to fill in implicit arguments and insert coercions on raw terms. Terms passed to Elpi tactics via tactic notations can be forced to be elaborated beforehand by declaring the parameters to be of type `constr` or `open_constr`. Arguments of type `uconstr` are passed raw. ##### Testing/debugging: - `Elpi Query [] ` runs `` in the current program (or in `` if specified). - `elpi query [] *` runs the `` predicate (that must have the same signature of the default predicate `solve`).

#### Supported features of Gallina (core calculus of Coq)
(click to expand) - [x] functional core (fun, forall, match, application, let-in, sorts) - [x] evars (unification variables) - [x] single Inductive and CoInductive types (including parameters, non-uniform parameters, indexes) - [ ] mutual Inductive and CoInductive types - [x] fixpoints - [ ] mutual fixpoints - [ ] cofixpoints - [x] primitive records - [x] primitive projections - [x] primitive integers - [x] primitive floats - [ ] primitive arrays - [x] universe polymorphism - [x] modules - [x] module types - [x] functor application - [x] functor definition

#### Supported features of Gallina's extensions (extra logical features, APIs)
(click to expand) Checked boxes are available, unchecked boxes are planned, missing items are not planned. This is a high level list, for the details see [coq-builtin](coq-builtin.elpi). - [x] i/o: messages, warnings, errors, Coq version - [x] logical environment: read, write, locate + [x] dependencies between objects - [x] type classes database: read, write + [ ] take over resolution - [x] canonical structures database: read, write + [ ] take over resolution - [x] coercions database: read, write - [x] sections: open, close - [x] scope management: import, export - [x] hints: mode, opaque, resolve, strategy - [x] arguments: implicit, name, scope, simpl - [x] abbreviations: read, write, locate - [x] typing and elaboration - [x] unification - [x] reduction: `lazy`, `cbv`, `vm`, `native` - [x] flags for `lazy` and `cbv` - [x] ltac1: bridge to call ltac1 code, mono and multi-goal tactics - [x] option system: get, set, add - [x] pretty printer: boxes, printing width - [x] attributes: read

#### Relevant files - [coq-builtin](coq-builtin.elpi) documents the HOAS encoding of Coq terms and the API to access Coq - [elpi-buitin](elpi-builtin.elpi) documents Elpi's standard library, you may look here for list processing code - [coq-lib](elpi/coq-lib.elpi) provides some utilities to manipulate Coq terms; it is an addendum to coq-builtin - [elpi-command-template](elpi/elpi-command-template.elpi) provides the pre-loaded code for `Elpi Command` - [elpi-tactic-template](elpi/elpi-tactic-template.elpi) provides the pre-loaded code for `Elpi Tactic` #### Organization of the repository The code of the Coq plugin is at the root of the repository in the [src](src/), [elpi](elpi/) and [theories](theories/) directories. The [apps](apps/) directory contains client applications written in Coq-Elpi. coq-elpi-1.19.3/_CoqProject000066400000000000000000000023111451177652200154600ustar00rootroot00000000000000-arg -w -arg +elpi.deprecated -R theories elpi -Q examples elpi.examples -Q tests elpi.tests -Q src elpi -Q apps/derive/tests elpi.apps.derive.tests -Q tests elpi.tests -Q elpi elpi -R apps/derive/theories elpi.apps -R apps/derive/tests elpi.apps.derive.tests -R apps/derive/examples elpi.apps.derive.examples -R apps/NES/theories elpi.apps -R apps/NES/tests elpi.apps.NES.tests -R apps/NES/examples elpi.apps.NES.examples -R apps/eltac/theories elpi.apps.eltac -R apps/eltac/tests elpi.apps.eltac.tests -R apps/eltac/examples elpi.apps.eltac.examples -R apps/coercion/theories elpi.apps.coercion theories/elpi.v theories/wip/memoization.v -I src src/META.coq-elpi src/coq_elpi_vernacular_syntax.mlg src/coq_elpi_vernacular.ml src/coq_elpi_vernacular.mli src/coq_elpi_programs.ml src/coq_elpi_programs.mli src/coq_elpi_utils.mli src/coq_elpi_utils.ml src/coq_elpi_HOAS.ml src/coq_elpi_HOAS.mli src/coq_elpi_name_quotation.ml src/coq_elpi_glob_quotation.ml src/coq_elpi_glob_quotation.mli src/coq_elpi_arg_HOAS.ml src/coq_elpi_arg_HOAS.mli src/coq_elpi_arg_syntax.mlg src/coq_elpi_builtins_HOAS.ml src/coq_elpi_builtins.ml src/coq_elpi_builtins.mli src/coq_elpi_config.ml src/elpi_plugin.mlpack coq-elpi-1.19.3/_CoqProject.examples000066400000000000000000000011611451177652200172770ustar00rootroot00000000000000-arg -w -arg +elpi.deprecated -arg -bt -Q theories elpi -Q examples elpi.examples -Q tests elpi.tests -I src/ -Q elpi unreleased -docroot elpi examples/tutorial_elpi_lang.v examples/tutorial_coq_elpi_HOAS.v examples/tutorial_coq_elpi_command.v examples/tutorial_coq_elpi_tactic.v examples/example_reflexive_tactic.v examples/example_curry_howard_tactics.v examples/example_data_base.v examples/example_record_expansion.v examples/example_record_to_sigma.v examples/example_fuzzer.v examples/example_generalize.v examples/example_import_projections.v examples/example_reduction_surgery.v examples/example_abs_evars.v coq-elpi-1.19.3/_CoqProject.test000066400000000000000000000023131451177652200164400ustar00rootroot00000000000000-arg -w -arg +elpi.deprecated -arg -bt -Q theories elpi -Q examples elpi.examples -Q tests elpi.tests -I src/ -Q elpi unreleased -docroot elpi tests/test_API.v tests/test_API_elaborate.v tests/test_API_typecheck.v tests/test_API_env.v tests/test_API_module.v tests/test_API_section.v tests/test_API_TC_CS.v tests/test_API_arguments.v tests/test_API_notations.v tests/test_API2.v tests/test_HOAS.v tests/test_arg_HOAS.v tests/test_quotation.v tests/test_vernacular1.v tests/test_vernacular2.v tests/test_tactic.v tests/test_elaborator.v tests/test_ltac.v tests/test_ltac2.v tests/test_ltac3.v tests/test_cache_async.v tests/test_COQ_ELPI_ATTRIBUTES.v tests/perf_calls.v tests/test_require_bad_order.v tests/test_ctx_cache.v tests/test_libobject_A.v tests/test_libobject_B.v tests/test_libobject_C.v tests/test_glob.v tests/test_link_perf.v tests/test_link_order1.v tests/test_link_order2.v tests/test_link_order3.v tests/test_link_order4.v tests/test_link_order5.v tests/test_link_order6.v tests/test_link_order7.v tests/test_link_order8.v tests/test_link_order9.v tests/test_API_new_pred.v tests/test_link_order_import0.v tests/test_link_order_import1.v tests/test_link_order_import2.v tests/test_link_order_import3.v coq-elpi-1.19.3/apps/000077500000000000000000000000001451177652200142735ustar00rootroot00000000000000coq-elpi-1.19.3/apps/NES/000077500000000000000000000000001451177652200147205ustar00rootroot00000000000000coq-elpi-1.19.3/apps/NES/Makefile000066400000000000000000000022501451177652200163570ustar00rootroot00000000000000# detection of coq ifeq "$(COQBIN)" "" COQBIN := $(shell which coqc >/dev/null 2>&1 && dirname `which coqc`) endif ifeq "$(COQBIN)" "" $(error Coq not found, make sure it is installed in your PATH or set COQBIN) else $(info Using coq found in $(COQBIN), from COQBIN or PATH) endif export COQBIN := $(COQBIN)/ all: build test build: Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq test: Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq theories/%.vo: force @$(MAKE) --no-print-directory -f Makefile.coq $@ tests/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ examples/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ Makefile.coq Makefile.coq.conf: _CoqProject @$(COQBIN)/coq_makefile -f _CoqProject -o Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq .merlin Makefile.test.coq Makefile.test.coq.conf: _CoqProject.test @$(COQBIN)/coq_makefile -f _CoqProject.test -o Makefile.test.coq clean: Makefile.coq Makefile.test.coq @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.19.3/apps/NES/Makefile.coq.local000066400000000000000000000002231451177652200202270ustar00rootroot00000000000000install-extra:: df="`$(COQMKFILE) -destination-of theories/NES.vo $(COQLIBS)`";\ install -m 0644 $(wildcard elpi/*.elpi) "$(COQLIBINSTALL)/$$df" coq-elpi-1.19.3/apps/NES/_CoqProject000066400000000000000000000002541451177652200170540ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps -R theories elpi.apps -Q elpi elpi.apps.NES theories/NES.v coq-elpi-1.19.3/apps/NES/_CoqProject.test000066400000000000000000000006111451177652200200270ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps -Q elpi elpi.apps.NES -R theories elpi.apps -R tests elpi.apps.NES.tests -R examples elpi.apps.NES.examples tests/test_NES.v tests/test_NES_resolve.v tests/test_NES_perf.v tests/test_NES_perf_optimal.v tests/test_module_namespace.v tests/test_NES_lib.v examples/usage_NES.vcoq-elpi-1.19.3/apps/NES/elpi/000077500000000000000000000000001451177652200156515ustar00rootroot00000000000000coq-elpi-1.19.3/apps/NES/elpi/nes.elpi000066400000000000000000000207531451177652200173200ustar00rootroot00000000000000namespace nes { pred ns->modpath i:prop, o:modpath. ns->modpath (ns _ M) M. pred open-ns->string i:prop, o:string. open-ns->string (open-ns S _) S. pred begin-ns i:string, i:list string, i:list prop, o:list prop. begin-ns NS Path In Out :- if (Path = []) (Fresh is NS ^ "_aux_" ^ {std.any->string {new_int} }, coq.env.begin-module Fresh none) true, coq.env.begin-module NS none, coq.env.current-path CP, Clause = open-ns NS CP, Out = [Clause | In], @local! => coq.elpi.accumulate current "NES.db" (clause _ (after "open-ns:begin") Clause). pred subpath i:list string, i:prop. subpath Path (ns Sub _) :- std.appendR _Prefix Path Sub. pred submod i:modpath, i:prop. submod Mod (ns _ SubMod) :- coq.modpath->path SubMod SubPath, coq.modpath->path Mod ModPath, std.appendR ModPath _Suffix SubPath. pred undup i:list A, i:list A, o:list A. undup [] _ []. undup [X|XS] Seen YS :- std.mem! Seen X, !, undup XS Seen YS. undup [X|XS] Seen [X|YS] :- undup XS [X|Seen] YS. % end-ns ID Stack ClauseIn ClauseOut pred end-ns i:string, i:list string, i:list prop, o:list prop. end-ns NS Stack In Out :- In => std.do! [ std.rev Stack Path, std.append Path [NS|END_] PathNoEnd, std.findall (ns PathNoEnd M_) AllNS, coq.env.end-module M, % stuff inside M std.filter AllNS (submod M) SubmodNS, % since the current program still sees the clauses that will be dropped % after closing M undup SubmodNS [] SubmodNSNodup, coq.locate-module NS M, if (Path = []) (std.do! [coq.env.end-module M_aux, coq.env.export-module M_aux, Local = @global!]) (Local = @local!), % NES.Open can put clauses in scope std.append Path [NS] NewPath, New = [ns NewPath M | SubmodNSNodup], std.append In New Out, std.forall New (c\ Local => coq.elpi.accumulate current "NES.db" (clause _ _ c)), ]. pred iter-> i:list A, i:list A, i:(A -> list A -> list prop -> list prop -> prop), i:list prop, o:list prop. iter-> _ [] _ O O :- coq.error "No elements". iter-> INIT [X] F In Out :- !, F X INIT In Out. iter-> INIT [X|XS] F In Out :- F X {std.append XS INIT} In Mid, iter-> INIT XS F Mid Out. pred iter<- i:list A, i:list A, i:(A -> list A -> list prop -> list prop -> prop), i:list prop, o:list prop. iter<- _ [] _ _ _ :- coq.error "No elements". iter<- INIT [X] F In Out :- !, F X INIT In Out. iter<- INIT [X|XS] F In Out :- iter<- INIT XS F In Mid, F X {std.append XS INIT} Mid Out. % Panics unless [S] well-formed. pred string->non-empty-ns i:string, o:list string. string->non-empty-ns S L :- std.do! [ Ident = "[a-zA-Z_][a-zA-Z_0-9']*", % non-unicode Coq identifiers Path is "^\\(" ^ Ident ^ "\\.\\)*" ^ Ident ^ "$", if (rex.match Path S) true (string->ns.err S), rex.split "\\." S L, if (std.mem L "_") (string->ns.err S) true, ]. pred string->ns.err i:string. string->ns.err S :- coq.error {calc ("NES: Bad : \"" ^ S ^ "\"")}. % Panics unless [S] empty, or well-formed. pred string->ns i:string, o:list string. string->ns "" [] :- !. string->ns S L :- string->non-empty-ns S L. pred ns->string i:list string, o:string. ns->string NS S :- nes.join "." NS S. :index (_ 1) pred join i:string, i:list string, o:string. join _ [] "". join _ [X] X :- !. join Sep [X|XS] S :- join Sep XS S0, S is X ^ Sep ^ S0. pred begin-path i:list string, o:list prop. begin-path [] []. begin-path ([_|_] as Path) Out :- std.do! [ coq.env.current-path CP, if (open-ns _ NSCP) (std.assert! (NSCP = CP) "NS: cannot begin a namespace inside a module that is inside a namespace") true, std.map {std.findall (open-ns Y_ P_)} open-ns->string Stack, if (Stack = []) true (std.do! [ coq.locate-all {join "." Path} L, if (std.do! [ std.mem L (loc-modpath M), coq.modpath->path M MP, MP = {std.append CP Path} ]) (iter-> [] Stack end-ns [] _, iter<- [] Stack begin-ns [] _) true, ]), iter<- Stack {std.rev Path} begin-ns [] Out, open-super-path Path [], ]. pred std.time-do! i:list prop. std.time-do! []. std.time-do! [P|PS] :- std.time P T, coq.say P "\ntakes" T "\n", !, std.time-do! PS. pred end-path i:list string, o:list prop. end-path [] []. end-path ([_|_] as Path) Out :- std.do! [ std.map {std.findall (open-ns X_ P_)} nes.open-ns->string Stack, std.assert! (std.appendR {std.rev Path} Bottom Stack) "NES: Ending a namespace that is not begun", nes.iter-> Bottom {std.rev Path} nes.end-ns [] Out, ]. pred open-path i:list string. open-path Path :- std.do! [ std.map {std.findall (ns Path M_)} nes.ns->modpath Mods, std.forall Mods coq.env.import-module ]. pred open-super-path i:list string, i:list string. open-super-path [] _. open-super-path [P|PS] ACC :- std.append ACC [P] Cur, open-path Cur, open-super-path PS Cur. % Currently open namespace, or []. pred current-path o:list string. current-path NS :- std.do! [ std.map {std.findall (open-ns X_ P_)} nes.open-ns->string Stack, std.rev Stack NS, ]. % Find an existing namespace, or panic. pred resolve i:string, o:list string. resolve S Path :- std.do! [ if (Top = "^_\\.", rex.match Top S) (std.do! [ rex.replace Top "" S S', string->non-empty-ns S' NS, if (ns NS _) (Path = NS) (resolve.err S'), ])( resolve.walk S {current-path} {string->non-empty-ns S} Path ), ]. pred resolve.walk i:string, i:list string, i:list string, o:list string. resolve.walk S Ctx SP Path :- std.do! [ std.append Ctx SP Candidate, ( ns Candidate _, Path = Candidate ; Ctx = [], resolve.err S ; resolve.walk S {std.drop-last 1 Ctx} SP Path ), ]. pred resolve.err i:string. resolve.err S :- coq.error "NES: Namespace not found:" S. % The (closed) namespace [NS] containing global [GR], or []. pred gref->path i:gref, o:list string. gref->path GR NS :- std.do! [ coq.gref->path GR MP, if (gref->path.aux MP NS) true (NS = []), ]. pred gref->path.aux i:list string, o:list string. gref->path.aux MP NS :- ns NS M, coq.modpath->path M MP, !. % Print a namespace pred print-path i:list string, i:(gref -> coq.pp -> prop). print-path Path PP :- std.do! [ std.map {std.findall (ns Path _)} (p\ mp\ p = ns _ mp) MPs, print.pp-list MPs (print.pp-module Path PP) Out, coq.say {coq.pp->string Out}, ]. namespace print { pred pp-list i:list A, i:(A -> coq.pp -> prop), o:coq.pp. pp-list L F Out :- std.do! [ std.map-filter L F PPs, Out = coq.pp.box (coq.pp.v 0) {std.intersperse (coq.pp.brk 0 0) PPs}, ]. kind context type. type context list string -> % readable path int -> % length of full path (gref -> coq.pp -> prop) -> context. % Hides `aux` modules pred readable-path i:context, i:list string, o:list string. readable-path (context Prefix N _) FullPath Path :- std.do! [ std.drop N FullPath RelPath, std.append Prefix RelPath Path, ]. pred module-context i:list string, i:modpath, i:(gref -> coq.pp -> prop), o:context. module-context Prefix MP PP Ctx :- std.do! [ coq.modpath->path MP FullPath, Ctx = context Prefix {std.length FullPath} PP, ]. pred submodule-context i:context, i:modpath, o:context. submodule-context (context _ _ PP as Ctx) MP Ctx' :- std.do! [ coq.modpath->path MP FullPath, readable-path Ctx FullPath Path, Ctx' = context Path {std.length FullPath} PP, ]. pred pp-module i:list string, i:(gref -> coq.pp -> prop), i:modpath, o:coq.pp. pp-module Prefix PP MP Out :- std.do! [ pp-module-items {module-context Prefix MP PP} {coq.env.module MP} Out, ]. pred pp-module-items i:context i:list module-item, o:coq.pp. pp-module-items Ctx Items Out :- pp-list Items (pp-module-item Ctx) Out. pred pp-module-item i:context, i:module-item, o:coq.pp. pp-module-item (context _ _ PP) (gref GR) Out :- PP GR Out, !. pp-module-item Ctx (submodule MP Items) Out :- std.do! [ pp-module-items {submodule-context Ctx MP} Items Out, ]. pp-module-item Ctx (module-type MTP) Out :- pp-modtypath Ctx MTP Out. pp-module-item Ctx (module-type-functor MTP _) Out :- pp-modtypath Ctx MTP Out. pp-module-item Ctx (module-functor MP _) Out :- pp-modpath Ctx MP Out. pred pp-path i:context, i:string, i:list string, o:coq.pp. pp-path Ctx What FullPath Out :- std.do! [ readable-path Ctx FullPath Path, Out = coq.pp.box coq.pp.h [ coq.pp.str What, coq.pp.spc, coq.pp.str {nes.join "." Path}, ], ]. pred pp-modtypath i:context, i:modtypath, o:coq.pp. pp-modtypath Ctx MTP Out :- std.do! [ pp-path Ctx "Module Type" {coq.modtypath->path MTP} Out, ]. pred pp-modpath i:context, i:modpath, o:coq.pp. pp-modpath Ctx MP Out :- std.do! [ pp-path Ctx "Module" {coq.modpath->path MP} Out, ]. } } coq-elpi-1.19.3/apps/NES/examples/000077500000000000000000000000001451177652200165365ustar00rootroot00000000000000coq-elpi-1.19.3/apps/NES/examples/usage_NES.v000066400000000000000000000037201451177652200205400ustar00rootroot00000000000000From elpi.apps Require Import NES. (* Namespaces are like modules, since they let you organize your notions and avoid name collisions. Namespaces are unlinke modules, since you can always add a notion to a namespace, even if the namespace was ended before. *) NES.Begin This.Is.A.Long.Namespace. Definition stuff := 1. NES.End This.Is.A.Long.Namespace. NES.Begin This.Is.A.Long.Namespace. Definition more_stuff := stuff. (* stuff in the namespace is visible *) NES.End This.Is.A.Long.Namespace. Print This.Is.A.Long.Namespace.stuff. (* = 1 *) Eval compute in This.Is.A.Long.Namespace.more_stuff. (* = 1 *) (* Unlike a module, a namespace can contain two notions with the same name. The latter shadows the former. *) NES.Begin This.Is.A.Long.Namespace. Definition stuff := 2. NES.End This.Is.A.Long.Namespace. (* Binding is static, eg more_stuff still values 1 *) Print This.Is.A.Long.Namespace.stuff. (* = 2 *) Eval compute in This.Is.A.Long.Namespace.more_stuff. (* = 1 *) (* Listing and printing namespaces *) NES.List This. (* This_aux_1.This.Is.A.Long.Namespace.stuff (* <-- shadowed *) This.Is.A.Long.Namespace.more_stuff This.Is.A.Long.Namespace.stuff *) NES.Print This. (* This_aux_1.This.Is.A.Long.Namespace.stuff : nat This.Is.A.Long.Namespace.more_stuff : nat This.Is.A.Long.Namespace.stuff : nat *) (* For convenience one can open a namespace to write short names *) NES.Open This.Is.A.Long.Namespace. Print stuff. (* Not quite a name space yet *) Structure Default := { sort : Type; default : sort }. NES.Begin CS. Global Canonical Structure nat_def := {| sort := nat; default := 46 |}. Check @default _ : nat. NES.End CS. Fail Check nat_def. (* we want nat_def to live in the CS namespace, BUT we want the canonical structure declaration to live outside the namespace *) Fail Check @default _ : nat. (* This behavior requires Libobject to be aware of the role played by a module: if it is a namespace some "actions" have to be propagated upward *) coq-elpi-1.19.3/apps/NES/tests/000077500000000000000000000000001451177652200160625ustar00rootroot00000000000000coq-elpi-1.19.3/apps/NES/tests/test_NES.v000066400000000000000000000023011451177652200177310ustar00rootroot00000000000000From elpi.apps Require Import NES. (* Some invalid namespaces *) Fail NES.Begin. Fail NES.Begin "". Fail NES.Begin ".". Fail NES.Begin ".A". Fail NES.Begin "A.". Fail NES.Begin "A..B". Fail NES.Begin "A._.B". (* name space creation *) NES.Begin Foo. Definition x := 3. NES.End Foo. Print Foo.x. (* adding one name inside an existing name space *) NES.Begin Foo. Definition x2 := 4. NES.End Foo. Print Foo.x. Print Foo.x2. (* shadowing: adding the same name twice *) NES.Begin Foo. Definition x := 5. NES.End Foo. Check (refl_equal _ : Foo.x = 5). (* shadowing *) (* nesting *) NES.Begin A. NES.Begin B. Definition c := 1. NES.End B. NES.End A. About A.B.c. (* adding one name inside an existing, nested, name space *) NES.Begin A1. NES.Begin B1. Definition c := 1. NES.End B1. NES.Begin B1. Definition d := 1. NES.End B1. NES.End A1. About A1.B1.d. About A1.B1.c. (* all names in the Foo namespace must be visible *) NES.Open Foo. Print x. Print x2. NES.Open A1. Print B1.c. Print B1.d. NES.Open A1.B1. Print d. (* boh *) NES.Begin A2.B2. Definition e := 1. NES.End B2. NES.End A2. NES.Begin A2.B2. Definition f := 2. NES.End A2.B2. Print A2.B2.f. NES.Begin X. Module Y. Fail NES.Begin Z. End Y. NES.End X.coq-elpi-1.19.3/apps/NES/tests/test_NES_lib.v000066400000000000000000000010021451177652200205540ustar00rootroot00000000000000From elpi.apps.NES Extra Dependency "nes.elpi" as nes. From elpi.apps Require Import NES. Elpi Command Make. Elpi Accumulate Db NES.db. Elpi Accumulate File nes. Elpi Accumulate lp:{{ main [str Path] :- std.do! [ nes.string->ns Path NS, nes.begin-path NS OpenNS, OpenNS => std.do! [ coq.env.add-const "x" {{ 42 }} _ @transparent! _C, nes.end-path NS _NewNS, ], ]. main _ :- coq.error "usage: Make ". }}. Elpi Typecheck. Elpi Export Make. Make Cats.And.Dogs. coq-elpi-1.19.3/apps/NES/tests/test_NES_perf.v000066400000000000000000000623321451177652200207570ustar00rootroot00000000000000From elpi.apps Require Import NES. NES.Begin NS1. Definition x := 0. NES.End NS1. NES.Begin NS2. Definition x := 0. NES.End NS2. NES.Begin NS3. Definition x := 0. NES.End NS3. NES.Begin NS4. Definition x := 0. NES.End NS4. NES.Begin NS5. Definition x := 0. NES.End NS5. NES.Begin NS6. Definition x := 0. NES.End NS6. NES.Begin NS7. Definition x := 0. NES.End NS7. NES.Begin NS8. Definition x := 0. NES.End NS8. NES.Begin NS9. Definition x := 0. NES.End NS9. NES.Begin NS10. Definition x := 0. NES.End NS10. NES.Begin NS11. Definition x := 0. NES.End NS11. NES.Begin NS12. Definition x := 0. NES.End NS12. NES.Begin NS13. Definition x := 0. NES.End NS13. NES.Begin NS14. Definition x := 0. NES.End NS14. NES.Begin NS15. Definition x := 0. NES.End NS15. NES.Begin NS16. Definition x := 0. NES.End NS16. NES.Begin NS17. Definition x := 0. NES.End NS17. NES.Begin NS18. Definition x := 0. NES.End NS18. NES.Begin NS19. Definition x := 0. NES.End NS19. NES.Begin NS20. Definition x := 0. NES.End NS20. NES.Begin NS21. Definition x := 0. NES.End NS21. NES.Begin NS22. Definition x := 0. NES.End NS22. NES.Begin NS23. Definition x := 0. NES.End NS23. NES.Begin NS24. Definition x := 0. NES.End NS24. NES.Begin NS25. Definition x := 0. NES.End NS25. NES.Begin NS26. Definition x := 0. NES.End NS26. NES.Begin NS27. Definition x := 0. NES.End NS27. NES.Begin NS28. Definition x := 0. NES.End NS28. NES.Begin NS29. Definition x := 0. NES.End NS29. NES.Begin NS30. Definition x := 0. NES.End NS30. NES.Begin NS31. Definition x := 0. NES.End NS31. NES.Begin NS32. Definition x := 0. NES.End NS32. NES.Begin NS33. Definition x := 0. NES.End NS33. NES.Begin NS34. Definition x := 0. NES.End NS34. NES.Begin NS35. Definition x := 0. NES.End NS35. NES.Begin NS36. Definition x := 0. NES.End NS36. NES.Begin NS37. Definition x := 0. NES.End NS37. NES.Begin NS38. Definition x := 0. NES.End NS38. NES.Begin NS39. Definition x := 0. NES.End NS39. NES.Begin NS40. Definition x := 0. NES.End NS40. NES.Begin NS41. Definition x := 0. NES.End NS41. NES.Begin NS42. Definition x := 0. NES.End NS42. NES.Begin NS43. Definition x := 0. NES.End NS43. NES.Begin NS44. Definition x := 0. NES.End NS44. NES.Begin NS45. Definition x := 0. NES.End NS45. NES.Begin NS46. Definition x := 0. NES.End NS46. NES.Begin NS47. Definition x := 0. NES.End NS47. NES.Begin NS48. Definition x := 0. NES.End NS48. NES.Begin NS49. Definition x := 0. NES.End NS49. NES.Begin NS50. Definition x := 0. NES.End NS50. NES.Begin NS51. Definition x := 0. NES.End NS51. NES.Begin NS52. Definition x := 0. NES.End NS52. NES.Begin NS53. Definition x := 0. NES.End NS53. NES.Begin NS54. Definition x := 0. NES.End NS54. NES.Begin NS55. Definition x := 0. NES.End NS55. NES.Begin NS56. Definition x := 0. NES.End NS56. NES.Begin NS57. Definition x := 0. NES.End NS57. NES.Begin NS58. Definition x := 0. NES.End NS58. NES.Begin NS59. Definition x := 0. NES.End NS59. NES.Begin NS60. Definition x := 0. NES.End NS60. NES.Begin NS61. Definition x := 0. NES.End NS61. NES.Begin NS62. Definition x := 0. NES.End NS62. NES.Begin NS63. Definition x := 0. NES.End NS63. NES.Begin NS64. Definition x := 0. NES.End NS64. NES.Begin NS65. Definition x := 0. NES.End NS65. NES.Begin NS66. Definition x := 0. NES.End NS66. NES.Begin NS67. Definition x := 0. NES.End NS67. NES.Begin NS68. Definition x := 0. NES.End NS68. NES.Begin NS69. Definition x := 0. NES.End NS69. NES.Begin NS70. Definition x := 0. NES.End NS70. NES.Begin NS71. Definition x := 0. NES.End NS71. NES.Begin NS72. Definition x := 0. NES.End NS72. NES.Begin NS73. Definition x := 0. NES.End NS73. NES.Begin NS74. Definition x := 0. NES.End NS74. NES.Begin NS75. Definition x := 0. NES.End NS75. NES.Begin NS76. Definition x := 0. NES.End NS76. NES.Begin NS77. Definition x := 0. NES.End NS77. NES.Begin NS78. Definition x := 0. NES.End NS78. NES.Begin NS79. Definition x := 0. NES.End NS79. NES.Begin NS80. Definition x := 0. NES.End NS80. NES.Begin NS81. Definition x := 0. NES.End NS81. NES.Begin NS82. Definition x := 0. NES.End NS82. NES.Begin NS83. Definition x := 0. NES.End NS83. NES.Begin NS84. Definition x := 0. NES.End NS84. NES.Begin NS85. Definition x := 0. NES.End NS85. NES.Begin NS86. Definition x := 0. NES.End NS86. NES.Begin NS87. Definition x := 0. NES.End NS87. NES.Begin NS88. Definition x := 0. NES.End NS88. NES.Begin NS89. Definition x := 0. NES.End NS89. NES.Begin NS90. Definition x := 0. NES.End NS90. NES.Begin NS91. Definition x := 0. NES.End NS91. NES.Begin NS92. Definition x := 0. NES.End NS92. NES.Begin NS93. Definition x := 0. NES.End NS93. NES.Begin NS94. Definition x := 0. NES.End NS94. NES.Begin NS95. Definition x := 0. NES.End NS95. NES.Begin NS96. Definition x := 0. NES.End NS96. NES.Begin NS97. Definition x := 0. NES.End NS97. NES.Begin NS98. Definition x := 0. NES.End NS98. NES.Begin NS99. Definition x := 0. NES.End NS99. NES.Begin NS100. Definition x := 0. NES.End NS100. NES.Begin NS101. Definition x := 0. NES.End NS101. NES.Begin NS102. Definition x := 0. NES.End NS102. NES.Begin NS103. Definition x := 0. NES.End NS103. NES.Begin NS104. Definition x := 0. NES.End NS104. NES.Begin NS105. Definition x := 0. NES.End NS105. NES.Begin NS106. Definition x := 0. NES.End NS106. NES.Begin NS107. Definition x := 0. NES.End NS107. NES.Begin NS108. Definition x := 0. NES.End NS108. NES.Begin NS109. Definition x := 0. NES.End NS109. NES.Begin NS110. Definition x := 0. NES.End NS110. NES.Begin NS111. Definition x := 0. NES.End NS111. NES.Begin NS112. Definition x := 0. NES.End NS112. NES.Begin NS113. Definition x := 0. NES.End NS113. NES.Begin NS114. Definition x := 0. NES.End NS114. NES.Begin NS115. Definition x := 0. NES.End NS115. NES.Begin NS116. Definition x := 0. NES.End NS116. NES.Begin NS117. Definition x := 0. NES.End NS117. NES.Begin NS118. Definition x := 0. NES.End NS118. NES.Begin NS119. Definition x := 0. NES.End NS119. NES.Begin NS120. Definition x := 0. NES.End NS120. NES.Begin NS121. Definition x := 0. NES.End NS121. NES.Begin NS122. Definition x := 0. NES.End NS122. NES.Begin NS123. Definition x := 0. NES.End NS123. NES.Begin NS124. Definition x := 0. NES.End NS124. NES.Begin NS125. Definition x := 0. NES.End NS125. NES.Begin NS126. Definition x := 0. NES.End NS126. NES.Begin NS127. Definition x := 0. NES.End NS127. NES.Begin NS128. Definition x := 0. NES.End NS128. NES.Begin NS129. Definition x := 0. NES.End NS129. NES.Begin NS130. Definition x := 0. NES.End NS130. NES.Begin NS131. Definition x := 0. NES.End NS131. NES.Begin NS132. Definition x := 0. NES.End NS132. NES.Begin NS133. Definition x := 0. NES.End NS133. NES.Begin NS134. Definition x := 0. NES.End NS134. NES.Begin NS135. Definition x := 0. NES.End NS135. NES.Begin NS136. Definition x := 0. NES.End NS136. NES.Begin NS137. Definition x := 0. NES.End NS137. NES.Begin NS138. Definition x := 0. NES.End NS138. NES.Begin NS139. Definition x := 0. NES.End NS139. NES.Begin NS140. Definition x := 0. NES.End NS140. NES.Begin NS141. Definition x := 0. NES.End NS141. NES.Begin NS142. Definition x := 0. NES.End NS142. NES.Begin NS143. Definition x := 0. NES.End NS143. NES.Begin NS144. Definition x := 0. NES.End NS144. NES.Begin NS145. Definition x := 0. NES.End NS145. NES.Begin NS146. Definition x := 0. NES.End NS146. NES.Begin NS147. Definition x := 0. NES.End NS147. NES.Begin NS148. Definition x := 0. NES.End NS148. NES.Begin NS149. Definition x := 0. NES.End NS149. NES.Begin NS150. Definition x := 0. NES.End NS150. NES.Begin NS151. Definition x := 0. NES.End NS151. NES.Begin NS152. Definition x := 0. NES.End NS152. NES.Begin NS153. Definition x := 0. NES.End NS153. NES.Begin NS154. Definition x := 0. NES.End NS154. NES.Begin NS155. Definition x := 0. NES.End NS155. NES.Begin NS156. Definition x := 0. NES.End NS156. NES.Begin NS157. Definition x := 0. NES.End NS157. NES.Begin NS158. Definition x := 0. NES.End NS158. NES.Begin NS159. Definition x := 0. NES.End NS159. NES.Begin NS160. Definition x := 0. NES.End NS160. NES.Begin NS161. Definition x := 0. NES.End NS161. NES.Begin NS162. Definition x := 0. NES.End NS162. NES.Begin NS163. Definition x := 0. NES.End NS163. NES.Begin NS164. Definition x := 0. NES.End NS164. NES.Begin NS165. Definition x := 0. NES.End NS165. NES.Begin NS166. Definition x := 0. NES.End NS166. NES.Begin NS167. Definition x := 0. NES.End NS167. NES.Begin NS168. Definition x := 0. NES.End NS168. NES.Begin NS169. Definition x := 0. NES.End NS169. NES.Begin NS170. Definition x := 0. NES.End NS170. NES.Begin NS171. Definition x := 0. NES.End NS171. NES.Begin NS172. Definition x := 0. NES.End NS172. NES.Begin NS173. Definition x := 0. NES.End NS173. NES.Begin NS174. Definition x := 0. NES.End NS174. NES.Begin NS175. Definition x := 0. NES.End NS175. NES.Begin NS176. Definition x := 0. NES.End NS176. NES.Begin NS177. Definition x := 0. NES.End NS177. NES.Begin NS178. Definition x := 0. NES.End NS178. NES.Begin NS179. Definition x := 0. NES.End NS179. NES.Begin NS180. Definition x := 0. NES.End NS180. NES.Begin NS181. Definition x := 0. NES.End NS181. NES.Begin NS182. Definition x := 0. NES.End NS182. NES.Begin NS183. Definition x := 0. NES.End NS183. NES.Begin NS184. Definition x := 0. NES.End NS184. NES.Begin NS185. Definition x := 0. NES.End NS185. NES.Begin NS186. Definition x := 0. NES.End NS186. NES.Begin NS187. Definition x := 0. NES.End NS187. NES.Begin NS188. Definition x := 0. NES.End NS188. NES.Begin NS189. Definition x := 0. NES.End NS189. NES.Begin NS190. Definition x := 0. NES.End NS190. NES.Begin NS191. Definition x := 0. NES.End NS191. NES.Begin NS192. Definition x := 0. NES.End NS192. NES.Begin NS193. Definition x := 0. NES.End NS193. NES.Begin NS194. Definition x := 0. NES.End NS194. NES.Begin NS195. Definition x := 0. NES.End NS195. NES.Begin NS196. Definition x := 0. NES.End NS196. NES.Begin NS197. Definition x := 0. NES.End NS197. NES.Begin NS198. Definition x := 0. NES.End NS198. NES.Begin NS199. Definition x := 0. NES.End NS199. NES.Begin NS200. Definition x := 0. NES.End NS200. NES.Begin NS201. Definition x := 0. NES.End NS201. NES.Begin NS202. Definition x := 0. NES.End NS202. NES.Begin NS203. Definition x := 0. NES.End NS203. NES.Begin NS204. Definition x := 0. NES.End NS204. NES.Begin NS205. Definition x := 0. NES.End NS205. NES.Begin NS206. Definition x := 0. NES.End NS206. NES.Begin NS207. Definition x := 0. NES.End NS207. NES.Begin NS208. Definition x := 0. NES.End NS208. NES.Begin NS209. Definition x := 0. NES.End NS209. NES.Begin NS210. Definition x := 0. NES.End NS210. NES.Begin NS211. Definition x := 0. NES.End NS211. NES.Begin NS212. Definition x := 0. NES.End NS212. NES.Begin NS213. Definition x := 0. NES.End NS213. NES.Begin NS214. Definition x := 0. NES.End NS214. NES.Begin NS215. Definition x := 0. NES.End NS215. NES.Begin NS216. Definition x := 0. NES.End NS216. NES.Begin NS217. Definition x := 0. NES.End NS217. NES.Begin NS218. Definition x := 0. NES.End NS218. NES.Begin NS219. Definition x := 0. NES.End NS219. NES.Begin NS220. Definition x := 0. NES.End NS220. NES.Begin NS221. Definition x := 0. NES.End NS221. NES.Begin NS222. Definition x := 0. NES.End NS222. NES.Begin NS223. Definition x := 0. NES.End NS223. NES.Begin NS224. Definition x := 0. NES.End NS224. NES.Begin NS225. Definition x := 0. NES.End NS225. NES.Begin NS226. Definition x := 0. NES.End NS226. NES.Begin NS227. Definition x := 0. NES.End NS227. NES.Begin NS228. Definition x := 0. NES.End NS228. NES.Begin NS229. Definition x := 0. NES.End NS229. NES.Begin NS230. Definition x := 0. NES.End NS230. NES.Begin NS231. Definition x := 0. NES.End NS231. NES.Begin NS232. Definition x := 0. NES.End NS232. NES.Begin NS233. Definition x := 0. NES.End NS233. NES.Begin NS234. Definition x := 0. NES.End NS234. NES.Begin NS235. Definition x := 0. NES.End NS235. NES.Begin NS236. Definition x := 0. NES.End NS236. NES.Begin NS237. Definition x := 0. NES.End NS237. NES.Begin NS238. Definition x := 0. NES.End NS238. NES.Begin NS239. Definition x := 0. NES.End NS239. NES.Begin NS240. Definition x := 0. NES.End NS240. NES.Begin NS241. Definition x := 0. NES.End NS241. NES.Begin NS242. Definition x := 0. NES.End NS242. NES.Begin NS243. Definition x := 0. NES.End NS243. NES.Begin NS244. Definition x := 0. NES.End NS244. NES.Begin NS245. Definition x := 0. NES.End NS245. NES.Begin NS246. Definition x := 0. NES.End NS246. NES.Begin NS247. Definition x := 0. NES.End NS247. NES.Begin NS248. Definition x := 0. NES.End NS248. NES.Begin NS249. Definition x := 0. NES.End NS249. NES.Begin NS250. Definition x := 0. NES.End NS250. NES.Begin NS251. Definition x := 0. NES.End NS251. NES.Begin NS252. Definition x := 0. NES.End NS252. NES.Begin NS253. Definition x := 0. NES.End NS253. NES.Begin NS254. Definition x := 0. NES.End NS254. NES.Begin NS255. Definition x := 0. NES.End NS255. NES.Begin NS256. Definition x := 0. NES.End NS256. NES.Begin NS257. Definition x := 0. NES.End NS257. NES.Begin NS258. Definition x := 0. NES.End NS258. NES.Begin NS259. Definition x := 0. NES.End NS259. NES.Begin NS260. Definition x := 0. NES.End NS260. NES.Begin NS261. Definition x := 0. NES.End NS261. NES.Begin NS262. Definition x := 0. NES.End NS262. NES.Begin NS263. Definition x := 0. NES.End NS263. NES.Begin NS264. Definition x := 0. NES.End NS264. NES.Begin NS265. Definition x := 0. NES.End NS265. NES.Begin NS266. Definition x := 0. NES.End NS266. NES.Begin NS267. Definition x := 0. NES.End NS267. NES.Begin NS268. Definition x := 0. NES.End NS268. NES.Begin NS269. Definition x := 0. NES.End NS269. NES.Begin NS270. Definition x := 0. NES.End NS270. NES.Begin NS271. Definition x := 0. NES.End NS271. NES.Begin NS272. Definition x := 0. NES.End NS272. NES.Begin NS273. Definition x := 0. NES.End NS273. NES.Begin NS274. Definition x := 0. NES.End NS274. NES.Begin NS275. Definition x := 0. NES.End NS275. NES.Begin NS276. Definition x := 0. NES.End NS276. NES.Begin NS277. Definition x := 0. NES.End NS277. NES.Begin NS278. Definition x := 0. NES.End NS278. NES.Begin NS279. Definition x := 0. NES.End NS279. NES.Begin NS280. Definition x := 0. NES.End NS280. NES.Begin NS281. Definition x := 0. NES.End NS281. NES.Begin NS282. Definition x := 0. NES.End NS282. NES.Begin NS283. Definition x := 0. NES.End NS283. NES.Begin NS284. Definition x := 0. NES.End NS284. NES.Begin NS285. Definition x := 0. NES.End NS285. NES.Begin NS286. Definition x := 0. NES.End NS286. NES.Begin NS287. Definition x := 0. NES.End NS287. NES.Begin NS288. Definition x := 0. NES.End NS288. NES.Begin NS289. Definition x := 0. NES.End NS289. NES.Begin NS290. Definition x := 0. NES.End NS290. NES.Begin NS291. Definition x := 0. NES.End NS291. NES.Begin NS292. Definition x := 0. NES.End NS292. NES.Begin NS293. Definition x := 0. NES.End NS293. NES.Begin NS294. Definition x := 0. NES.End NS294. NES.Begin NS295. Definition x := 0. NES.End NS295. NES.Begin NS296. Definition x := 0. NES.End NS296. NES.Begin NS297. Definition x := 0. NES.End NS297. NES.Begin NS298. Definition x := 0. NES.End NS298. NES.Begin NS299. Definition x := 0. NES.End NS299. NES.Begin NS300. Definition x := 0. NES.End NS300. NES.Begin NS301. Definition x := 0. NES.End NS301. NES.Begin NS302. Definition x := 0. NES.End NS302. NES.Begin NS303. Definition x := 0. NES.End NS303. NES.Begin NS304. Definition x := 0. NES.End NS304. NES.Begin NS305. Definition x := 0. NES.End NS305. NES.Begin NS306. Definition x := 0. NES.End NS306. NES.Begin NS307. Definition x := 0. NES.End NS307. NES.Begin NS308. Definition x := 0. NES.End NS308. NES.Begin NS309. Definition x := 0. NES.End NS309. NES.Begin NS310. Definition x := 0. NES.End NS310. NES.Begin NS311. Definition x := 0. NES.End NS311. NES.Begin NS312. Definition x := 0. NES.End NS312. NES.Begin NS313. Definition x := 0. NES.End NS313. NES.Begin NS314. Definition x := 0. NES.End NS314. NES.Begin NS315. Definition x := 0. NES.End NS315. NES.Begin NS316. Definition x := 0. NES.End NS316. NES.Begin NS317. Definition x := 0. NES.End NS317. NES.Begin NS318. Definition x := 0. NES.End NS318. NES.Begin NS319. Definition x := 0. NES.End NS319. NES.Begin NS320. Definition x := 0. NES.End NS320. NES.Begin NS321. Definition x := 0. NES.End NS321. NES.Begin NS322. Definition x := 0. NES.End NS322. NES.Begin NS323. Definition x := 0. NES.End NS323. NES.Begin NS324. Definition x := 0. NES.End NS324. NES.Begin NS325. Definition x := 0. NES.End NS325. NES.Begin NS326. Definition x := 0. NES.End NS326. NES.Begin NS327. Definition x := 0. NES.End NS327. NES.Begin NS328. Definition x := 0. NES.End NS328. NES.Begin NS329. Definition x := 0. NES.End NS329. NES.Begin NS330. Definition x := 0. NES.End NS330. NES.Begin NS331. Definition x := 0. NES.End NS331. NES.Begin NS332. Definition x := 0. NES.End NS332. NES.Begin NS333. Definition x := 0. NES.End NS333. NES.Begin NS334. Definition x := 0. NES.End NS334. NES.Begin NS335. Definition x := 0. NES.End NS335. NES.Begin NS336. Definition x := 0. NES.End NS336. NES.Begin NS337. Definition x := 0. NES.End NS337. NES.Begin NS338. Definition x := 0. NES.End NS338. NES.Begin NS339. Definition x := 0. NES.End NS339. NES.Begin NS340. Definition x := 0. NES.End NS340. NES.Begin NS341. Definition x := 0. NES.End NS341. NES.Begin NS342. Definition x := 0. NES.End NS342. NES.Begin NS343. Definition x := 0. NES.End NS343. NES.Begin NS344. Definition x := 0. NES.End NS344. NES.Begin NS345. Definition x := 0. NES.End NS345. NES.Begin NS346. Definition x := 0. NES.End NS346. NES.Begin NS347. Definition x := 0. NES.End NS347. NES.Begin NS348. Definition x := 0. NES.End NS348. NES.Begin NS349. Definition x := 0. NES.End NS349. NES.Begin NS350. Definition x := 0. NES.End NS350. NES.Begin NS351. Definition x := 0. NES.End NS351. NES.Begin NS352. Definition x := 0. NES.End NS352. NES.Begin NS353. Definition x := 0. NES.End NS353. NES.Begin NS354. Definition x := 0. NES.End NS354. NES.Begin NS355. Definition x := 0. NES.End NS355. NES.Begin NS356. Definition x := 0. NES.End NS356. NES.Begin NS357. Definition x := 0. NES.End NS357. NES.Begin NS358. Definition x := 0. NES.End NS358. NES.Begin NS359. Definition x := 0. NES.End NS359. NES.Begin NS360. Definition x := 0. NES.End NS360. NES.Begin NS361. Definition x := 0. NES.End NS361. NES.Begin NS362. Definition x := 0. NES.End NS362. NES.Begin NS363. Definition x := 0. NES.End NS363. NES.Begin NS364. Definition x := 0. NES.End NS364. NES.Begin NS365. Definition x := 0. NES.End NS365. NES.Begin NS366. Definition x := 0. NES.End NS366. NES.Begin NS367. Definition x := 0. NES.End NS367. NES.Begin NS368. Definition x := 0. NES.End NS368. NES.Begin NS369. Definition x := 0. NES.End NS369. NES.Begin NS370. Definition x := 0. NES.End NS370. NES.Begin NS371. Definition x := 0. NES.End NS371. NES.Begin NS372. Definition x := 0. NES.End NS372. NES.Begin NS373. Definition x := 0. NES.End NS373. NES.Begin NS374. Definition x := 0. NES.End NS374. NES.Begin NS375. Definition x := 0. NES.End NS375. NES.Begin NS376. Definition x := 0. NES.End NS376. NES.Begin NS377. Definition x := 0. NES.End NS377. NES.Begin NS378. Definition x := 0. NES.End NS378. NES.Begin NS379. Definition x := 0. NES.End NS379. NES.Begin NS380. Definition x := 0. NES.End NS380. NES.Begin NS381. Definition x := 0. NES.End NS381. NES.Begin NS382. Definition x := 0. NES.End NS382. NES.Begin NS383. Definition x := 0. NES.End NS383. NES.Begin NS384. Definition x := 0. NES.End NS384. NES.Begin NS385. Definition x := 0. NES.End NS385. NES.Begin NS386. Definition x := 0. NES.End NS386. NES.Begin NS387. Definition x := 0. NES.End NS387. NES.Begin NS388. Definition x := 0. NES.End NS388. NES.Begin NS389. Definition x := 0. NES.End NS389. NES.Begin NS390. Definition x := 0. NES.End NS390. NES.Begin NS391. Definition x := 0. NES.End NS391. NES.Begin NS392. Definition x := 0. NES.End NS392. NES.Begin NS393. Definition x := 0. NES.End NS393. NES.Begin NS394. Definition x := 0. NES.End NS394. NES.Begin NS395. Definition x := 0. NES.End NS395. NES.Begin NS396. Definition x := 0. NES.End NS396. NES.Begin NS397. Definition x := 0. NES.End NS397. NES.Begin NS398. Definition x := 0. NES.End NS398. NES.Begin NS399. Definition x := 0. NES.End NS399. NES.Begin NS400. Definition x := 0. NES.End NS400. NES.Begin NS401. Definition x := 0. NES.End NS401. NES.Begin NS402. Definition x := 0. NES.End NS402. NES.Begin NS403. Definition x := 0. NES.End NS403. NES.Begin NS404. Definition x := 0. NES.End NS404. NES.Begin NS405. Definition x := 0. NES.End NS405. NES.Begin NS406. Definition x := 0. NES.End NS406. NES.Begin NS407. Definition x := 0. NES.End NS407. NES.Begin NS408. Definition x := 0. NES.End NS408. NES.Begin NS409. Definition x := 0. NES.End NS409. NES.Begin NS410. Definition x := 0. NES.End NS410. NES.Begin NS411. Definition x := 0. NES.End NS411. NES.Begin NS412. Definition x := 0. NES.End NS412. NES.Begin NS413. Definition x := 0. NES.End NS413. NES.Begin NS414. Definition x := 0. NES.End NS414. NES.Begin NS415. Definition x := 0. NES.End NS415. NES.Begin NS416. Definition x := 0. NES.End NS416. NES.Begin NS417. Definition x := 0. NES.End NS417. NES.Begin NS418. Definition x := 0. NES.End NS418. NES.Begin NS419. Definition x := 0. NES.End NS419. NES.Begin NS420. Definition x := 0. NES.End NS420. NES.Begin NS421. Definition x := 0. NES.End NS421. NES.Begin NS422. Definition x := 0. NES.End NS422. NES.Begin NS423. Definition x := 0. NES.End NS423. NES.Begin NS424. Definition x := 0. NES.End NS424. NES.Begin NS425. Definition x := 0. NES.End NS425. NES.Begin NS426. Definition x := 0. NES.End NS426. NES.Begin NS427. Definition x := 0. NES.End NS427. NES.Begin NS428. Definition x := 0. NES.End NS428. NES.Begin NS429. Definition x := 0. NES.End NS429. NES.Begin NS430. Definition x := 0. NES.End NS430. NES.Begin NS431. Definition x := 0. NES.End NS431. NES.Begin NS432. Definition x := 0. NES.End NS432. NES.Begin NS433. Definition x := 0. NES.End NS433. NES.Begin NS434. Definition x := 0. NES.End NS434. NES.Begin NS435. Definition x := 0. NES.End NS435. NES.Begin NS436. Definition x := 0. NES.End NS436. NES.Begin NS437. Definition x := 0. NES.End NS437. NES.Begin NS438. Definition x := 0. NES.End NS438. NES.Begin NS439. Definition x := 0. NES.End NS439. NES.Begin NS440. Definition x := 0. NES.End NS440. NES.Begin NS441. Definition x := 0. NES.End NS441. NES.Begin NS442. Definition x := 0. NES.End NS442. NES.Begin NS443. Definition x := 0. NES.End NS443. NES.Begin NS444. Definition x := 0. NES.End NS444. NES.Begin NS445. Definition x := 0. NES.End NS445. NES.Begin NS446. Definition x := 0. NES.End NS446. NES.Begin NS447. Definition x := 0. NES.End NS447. NES.Begin NS448. Definition x := 0. NES.End NS448. NES.Begin NS449. Definition x := 0. NES.End NS449. NES.Begin NS450. Definition x := 0. NES.End NS450. NES.Begin NS451. Definition x := 0. NES.End NS451. NES.Begin NS452. Definition x := 0. NES.End NS452. NES.Begin NS453. Definition x := 0. NES.End NS453. NES.Begin NS454. Definition x := 0. NES.End NS454. NES.Begin NS455. Definition x := 0. NES.End NS455. NES.Begin NS456. Definition x := 0. NES.End NS456. NES.Begin NS457. Definition x := 0. NES.End NS457. NES.Begin NS458. Definition x := 0. NES.End NS458. NES.Begin NS459. Definition x := 0. NES.End NS459. NES.Begin NS460. Definition x := 0. NES.End NS460. NES.Begin NS461. Definition x := 0. NES.End NS461. NES.Begin NS462. Definition x := 0. NES.End NS462. NES.Begin NS463. Definition x := 0. NES.End NS463. NES.Begin NS464. Definition x := 0. NES.End NS464. NES.Begin NS465. Definition x := 0. NES.End NS465. NES.Begin NS466. Definition x := 0. NES.End NS466. NES.Begin NS467. Definition x := 0. NES.End NS467. NES.Begin NS468. Definition x := 0. NES.End NS468. NES.Begin NS469. Definition x := 0. NES.End NS469. NES.Begin NS470. Definition x := 0. NES.End NS470. NES.Begin NS471. Definition x := 0. NES.End NS471. NES.Begin NS472. Definition x := 0. NES.End NS472. NES.Begin NS473. Definition x := 0. NES.End NS473. NES.Begin NS474. Definition x := 0. NES.End NS474. NES.Begin NS475. Definition x := 0. NES.End NS475. NES.Begin NS476. Definition x := 0. NES.End NS476. NES.Begin NS477. Definition x := 0. NES.End NS477. NES.Begin NS478. Definition x := 0. NES.End NS478. NES.Begin NS479. Definition x := 0. NES.End NS479. NES.Begin NS480. Definition x := 0. NES.End NS480. NES.Begin NS481. Definition x := 0. NES.End NS481. NES.Begin NS482. Definition x := 0. NES.End NS482. NES.Begin NS483. Definition x := 0. NES.End NS483. NES.Begin NS484. Definition x := 0. NES.End NS484. NES.Begin NS485. Definition x := 0. NES.End NS485. NES.Begin NS486. Definition x := 0. NES.End NS486. NES.Begin NS487. Definition x := 0. NES.End NS487. NES.Begin NS488. Definition x := 0. NES.End NS488. NES.Begin NS489. Definition x := 0. NES.End NS489. NES.Begin NS490. Definition x := 0. NES.End NS490. NES.Begin NS491. Definition x := 0. NES.End NS491. NES.Begin NS492. Definition x := 0. NES.End NS492. NES.Begin NS493. Definition x := 0. NES.End NS493. NES.Begin NS494. Definition x := 0. NES.End NS494. NES.Begin NS495. Definition x := 0. NES.End NS495. NES.Begin NS496. Definition x := 0. NES.End NS496. NES.Begin NS497. Definition x := 0. NES.End NS497. NES.Begin NS498. Definition x := 0. NES.End NS498. NES.Begin NS499. Definition x := 0. NES.End NS499. NES.Begin NS500. Definition x := 0. NES.End NS500.coq-elpi-1.19.3/apps/NES/tests/test_NES_perf_optimal.v000066400000000000000000001210261451177652200225000ustar00rootroot00000000000000From elpi.apps Require Import NES. Module NS1. Module NS1. Definition x := 0. End NS1. End NS1. Export NS1. Module NS2. Module NS2. Definition x := 0. End NS2. End NS2. Export NS2. Module NS3. Module NS3. Definition x := 0. End NS3. End NS3. Export NS3. Module NS4. Module NS4. Definition x := 0. End NS4. End NS4. Export NS4. Module NS5. Module NS5. Definition x := 0. End NS5. End NS5. Export NS5. Module NS6. Module NS6. Definition x := 0. End NS6. End NS6. Export NS6. Module NS7. Module NS7. Definition x := 0. End NS7. End NS7. Export NS7. Module NS8. Module NS8. Definition x := 0. End NS8. End NS8. Export NS8. Module NS9. Module NS9. Definition x := 0. End NS9. End NS9. Export NS9. Module NS10. Module NS10. Definition x := 0. End NS10. End NS10. Export NS10. Module NS11. Module NS11. Definition x := 0. End NS11. End NS11. Export NS11. Module NS12. Module NS12. Definition x := 0. End NS12. End NS12. Export NS12. Module NS13. Module NS13. Definition x := 0. End NS13. End NS13. Export NS13. Module NS14. Module NS14. Definition x := 0. End NS14. End NS14. Export NS14. Module NS15. Module NS15. Definition x := 0. End NS15. End NS15. Export NS15. Module NS16. Module NS16. Definition x := 0. End NS16. End NS16. Export NS16. Module NS17. Module NS17. Definition x := 0. End NS17. End NS17. Export NS17. Module NS18. Module NS18. Definition x := 0. End NS18. End NS18. Export NS18. Module NS19. Module NS19. Definition x := 0. End NS19. End NS19. Export NS19. Module NS20. Module NS20. Definition x := 0. End NS20. End NS20. Export NS20. Module NS21. Module NS21. Definition x := 0. End NS21. End NS21. Export NS21. Module NS22. Module NS22. Definition x := 0. End NS22. End NS22. Export NS22. Module NS23. Module NS23. Definition x := 0. End NS23. End NS23. Export NS23. Module NS24. Module NS24. Definition x := 0. End NS24. End NS24. Export NS24. Module NS25. Module NS25. Definition x := 0. End NS25. End NS25. Export NS25. Module NS26. Module NS26. Definition x := 0. End NS26. End NS26. Export NS26. Module NS27. Module NS27. Definition x := 0. End NS27. End NS27. Export NS27. Module NS28. Module NS28. Definition x := 0. End NS28. End NS28. Export NS28. Module NS29. Module NS29. Definition x := 0. End NS29. End NS29. Export NS29. Module NS30. Module NS30. Definition x := 0. End NS30. End NS30. Export NS30. Module NS31. Module NS31. Definition x := 0. End NS31. End NS31. Export NS31. Module NS32. Module NS32. Definition x := 0. End NS32. End NS32. Export NS32. Module NS33. Module NS33. Definition x := 0. End NS33. End NS33. Export NS33. Module NS34. Module NS34. Definition x := 0. End NS34. End NS34. Export NS34. Module NS35. Module NS35. Definition x := 0. End NS35. End NS35. Export NS35. Module NS36. Module NS36. Definition x := 0. End NS36. End NS36. Export NS36. Module NS37. Module NS37. Definition x := 0. End NS37. End NS37. Export NS37. Module NS38. Module NS38. Definition x := 0. End NS38. End NS38. Export NS38. Module NS39. Module NS39. Definition x := 0. End NS39. End NS39. Export NS39. Module NS40. Module NS40. Definition x := 0. End NS40. End NS40. Export NS40. Module NS41. Module NS41. Definition x := 0. End NS41. End NS41. Export NS41. Module NS42. Module NS42. Definition x := 0. End NS42. End NS42. Export NS42. Module NS43. Module NS43. Definition x := 0. End NS43. End NS43. Export NS43. Module NS44. Module NS44. Definition x := 0. End NS44. End NS44. Export NS44. Module NS45. Module NS45. Definition x := 0. End NS45. End NS45. Export NS45. Module NS46. Module NS46. Definition x := 0. End NS46. End NS46. Export NS46. Module NS47. Module NS47. Definition x := 0. End NS47. End NS47. Export NS47. Module NS48. Module NS48. Definition x := 0. End NS48. End NS48. Export NS48. Module NS49. Module NS49. Definition x := 0. End NS49. End NS49. Export NS49. Module NS50. Module NS50. Definition x := 0. End NS50. End NS50. Export NS50. Module NS51. Module NS51. Definition x := 0. End NS51. End NS51. Export NS51. Module NS52. Module NS52. Definition x := 0. End NS52. End NS52. Export NS52. Module NS53. Module NS53. Definition x := 0. End NS53. End NS53. Export NS53. Module NS54. Module NS54. Definition x := 0. End NS54. End NS54. Export NS54. Module NS55. Module NS55. Definition x := 0. End NS55. End NS55. Export NS55. Module NS56. Module NS56. Definition x := 0. End NS56. End NS56. Export NS56. Module NS57. Module NS57. Definition x := 0. End NS57. End NS57. Export NS57. Module NS58. Module NS58. Definition x := 0. End NS58. End NS58. Export NS58. Module NS59. Module NS59. Definition x := 0. End NS59. End NS59. Export NS59. Module NS60. Module NS60. Definition x := 0. End NS60. End NS60. Export NS60. Module NS61. Module NS61. Definition x := 0. End NS61. End NS61. Export NS61. Module NS62. Module NS62. Definition x := 0. End NS62. End NS62. Export NS62. Module NS63. Module NS63. Definition x := 0. End NS63. End NS63. Export NS63. Module NS64. Module NS64. Definition x := 0. End NS64. End NS64. Export NS64. Module NS65. Module NS65. Definition x := 0. End NS65. End NS65. Export NS65. Module NS66. Module NS66. Definition x := 0. End NS66. End NS66. Export NS66. Module NS67. Module NS67. Definition x := 0. End NS67. End NS67. Export NS67. Module NS68. Module NS68. Definition x := 0. End NS68. End NS68. Export NS68. Module NS69. Module NS69. Definition x := 0. End NS69. End NS69. Export NS69. Module NS70. Module NS70. Definition x := 0. End NS70. End NS70. Export NS70. Module NS71. Module NS71. Definition x := 0. End NS71. End NS71. Export NS71. Module NS72. Module NS72. Definition x := 0. End NS72. End NS72. Export NS72. Module NS73. Module NS73. Definition x := 0. End NS73. End NS73. Export NS73. Module NS74. Module NS74. Definition x := 0. End NS74. End NS74. Export NS74. Module NS75. Module NS75. Definition x := 0. End NS75. End NS75. Export NS75. Module NS76. Module NS76. Definition x := 0. End NS76. End NS76. Export NS76. Module NS77. Module NS77. Definition x := 0. End NS77. End NS77. Export NS77. Module NS78. Module NS78. Definition x := 0. End NS78. End NS78. Export NS78. Module NS79. Module NS79. Definition x := 0. End NS79. End NS79. Export NS79. Module NS80. Module NS80. Definition x := 0. End NS80. End NS80. Export NS80. Module NS81. Module NS81. Definition x := 0. End NS81. End NS81. Export NS81. Module NS82. Module NS82. Definition x := 0. End NS82. End NS82. Export NS82. Module NS83. Module NS83. Definition x := 0. End NS83. End NS83. Export NS83. Module NS84. Module NS84. Definition x := 0. End NS84. End NS84. Export NS84. Module NS85. Module NS85. Definition x := 0. End NS85. End NS85. Export NS85. Module NS86. Module NS86. Definition x := 0. End NS86. End NS86. Export NS86. Module NS87. Module NS87. Definition x := 0. End NS87. End NS87. Export NS87. Module NS88. Module NS88. Definition x := 0. End NS88. End NS88. Export NS88. Module NS89. Module NS89. Definition x := 0. End NS89. End NS89. Export NS89. Module NS90. Module NS90. Definition x := 0. End NS90. End NS90. Export NS90. Module NS91. Module NS91. Definition x := 0. End NS91. End NS91. Export NS91. Module NS92. Module NS92. Definition x := 0. End NS92. End NS92. Export NS92. Module NS93. Module NS93. Definition x := 0. End NS93. End NS93. Export NS93. Module NS94. Module NS94. Definition x := 0. End NS94. End NS94. Export NS94. Module NS95. Module NS95. Definition x := 0. End NS95. End NS95. Export NS95. Module NS96. Module NS96. Definition x := 0. End NS96. End NS96. Export NS96. Module NS97. Module NS97. Definition x := 0. End NS97. End NS97. Export NS97. Module NS98. Module NS98. Definition x := 0. End NS98. End NS98. Export NS98. Module NS99. Module NS99. Definition x := 0. End NS99. End NS99. Export NS99. Module NS100. Module NS100. Definition x := 0. End NS100. End NS100. Export NS100. Module NS101. Module NS101. Definition x := 0. End NS101. End NS101. Export NS101. Module NS102. Module NS102. Definition x := 0. End NS102. End NS102. Export NS102. Module NS103. Module NS103. Definition x := 0. End NS103. End NS103. Export NS103. Module NS104. Module NS104. Definition x := 0. End NS104. End NS104. Export NS104. Module NS105. Module NS105. Definition x := 0. End NS105. End NS105. Export NS105. Module NS106. Module NS106. Definition x := 0. End NS106. End NS106. Export NS106. Module NS107. Module NS107. Definition x := 0. End NS107. End NS107. Export NS107. Module NS108. Module NS108. Definition x := 0. End NS108. End NS108. Export NS108. Module NS109. Module NS109. Definition x := 0. End NS109. End NS109. Export NS109. Module NS110. Module NS110. Definition x := 0. End NS110. End NS110. Export NS110. Module NS111. Module NS111. Definition x := 0. End NS111. End NS111. Export NS111. Module NS112. Module NS112. Definition x := 0. End NS112. End NS112. Export NS112. Module NS113. Module NS113. Definition x := 0. End NS113. End NS113. Export NS113. Module NS114. Module NS114. Definition x := 0. End NS114. End NS114. Export NS114. Module NS115. Module NS115. Definition x := 0. End NS115. End NS115. Export NS115. Module NS116. Module NS116. Definition x := 0. End NS116. End NS116. Export NS116. Module NS117. Module NS117. Definition x := 0. End NS117. End NS117. Export NS117. Module NS118. Module NS118. Definition x := 0. End NS118. End NS118. Export NS118. Module NS119. Module NS119. Definition x := 0. End NS119. End NS119. Export NS119. Module NS120. Module NS120. Definition x := 0. End NS120. End NS120. Export NS120. Module NS121. Module NS121. Definition x := 0. End NS121. End NS121. Export NS121. Module NS122. Module NS122. Definition x := 0. End NS122. End NS122. Export NS122. Module NS123. Module NS123. Definition x := 0. End NS123. End NS123. Export NS123. Module NS124. Module NS124. Definition x := 0. End NS124. End NS124. Export NS124. Module NS125. Module NS125. Definition x := 0. End NS125. End NS125. Export NS125. Module NS126. Module NS126. Definition x := 0. End NS126. End NS126. Export NS126. Module NS127. Module NS127. Definition x := 0. End NS127. End NS127. Export NS127. Module NS128. Module NS128. Definition x := 0. End NS128. End NS128. Export NS128. Module NS129. Module NS129. Definition x := 0. End NS129. End NS129. Export NS129. Module NS130. Module NS130. Definition x := 0. End NS130. End NS130. Export NS130. Module NS131. Module NS131. Definition x := 0. End NS131. End NS131. Export NS131. Module NS132. Module NS132. Definition x := 0. End NS132. End NS132. Export NS132. Module NS133. Module NS133. Definition x := 0. End NS133. End NS133. Export NS133. Module NS134. Module NS134. Definition x := 0. End NS134. End NS134. Export NS134. Module NS135. Module NS135. Definition x := 0. End NS135. End NS135. Export NS135. Module NS136. Module NS136. Definition x := 0. End NS136. End NS136. Export NS136. Module NS137. Module NS137. Definition x := 0. End NS137. End NS137. Export NS137. Module NS138. Module NS138. Definition x := 0. End NS138. End NS138. Export NS138. Module NS139. Module NS139. Definition x := 0. End NS139. End NS139. Export NS139. Module NS140. Module NS140. Definition x := 0. End NS140. End NS140. Export NS140. Module NS141. Module NS141. Definition x := 0. End NS141. End NS141. Export NS141. Module NS142. Module NS142. Definition x := 0. End NS142. End NS142. Export NS142. Module NS143. Module NS143. Definition x := 0. End NS143. End NS143. Export NS143. Module NS144. Module NS144. Definition x := 0. End NS144. End NS144. Export NS144. Module NS145. Module NS145. Definition x := 0. End NS145. End NS145. Export NS145. Module NS146. Module NS146. Definition x := 0. End NS146. End NS146. Export NS146. Module NS147. Module NS147. Definition x := 0. End NS147. End NS147. Export NS147. Module NS148. Module NS148. Definition x := 0. End NS148. End NS148. Export NS148. Module NS149. Module NS149. Definition x := 0. End NS149. End NS149. Export NS149. Module NS150. Module NS150. Definition x := 0. End NS150. End NS150. Export NS150. Module NS151. Module NS151. Definition x := 0. End NS151. End NS151. Export NS151. Module NS152. Module NS152. Definition x := 0. End NS152. End NS152. Export NS152. Module NS153. Module NS153. Definition x := 0. End NS153. End NS153. Export NS153. Module NS154. Module NS154. Definition x := 0. End NS154. End NS154. Export NS154. Module NS155. Module NS155. Definition x := 0. End NS155. End NS155. Export NS155. Module NS156. Module NS156. Definition x := 0. End NS156. End NS156. Export NS156. Module NS157. Module NS157. Definition x := 0. End NS157. End NS157. Export NS157. Module NS158. Module NS158. Definition x := 0. End NS158. End NS158. Export NS158. Module NS159. Module NS159. Definition x := 0. End NS159. End NS159. Export NS159. Module NS160. Module NS160. Definition x := 0. End NS160. End NS160. Export NS160. Module NS161. Module NS161. Definition x := 0. End NS161. End NS161. Export NS161. Module NS162. Module NS162. Definition x := 0. End NS162. End NS162. Export NS162. Module NS163. Module NS163. Definition x := 0. End NS163. End NS163. Export NS163. Module NS164. Module NS164. Definition x := 0. End NS164. End NS164. Export NS164. Module NS165. Module NS165. Definition x := 0. End NS165. End NS165. Export NS165. Module NS166. Module NS166. Definition x := 0. End NS166. End NS166. Export NS166. Module NS167. Module NS167. Definition x := 0. End NS167. End NS167. Export NS167. Module NS168. Module NS168. Definition x := 0. End NS168. End NS168. Export NS168. Module NS169. Module NS169. Definition x := 0. End NS169. End NS169. Export NS169. Module NS170. Module NS170. Definition x := 0. End NS170. End NS170. Export NS170. Module NS171. Module NS171. Definition x := 0. End NS171. End NS171. Export NS171. Module NS172. Module NS172. Definition x := 0. End NS172. End NS172. Export NS172. Module NS173. Module NS173. Definition x := 0. End NS173. End NS173. Export NS173. Module NS174. Module NS174. Definition x := 0. End NS174. End NS174. Export NS174. Module NS175. Module NS175. Definition x := 0. End NS175. End NS175. Export NS175. Module NS176. Module NS176. Definition x := 0. End NS176. End NS176. Export NS176. Module NS177. Module NS177. Definition x := 0. End NS177. End NS177. Export NS177. Module NS178. Module NS178. Definition x := 0. End NS178. End NS178. Export NS178. Module NS179. Module NS179. Definition x := 0. End NS179. End NS179. Export NS179. Module NS180. Module NS180. Definition x := 0. End NS180. End NS180. Export NS180. Module NS181. Module NS181. Definition x := 0. End NS181. End NS181. Export NS181. Module NS182. Module NS182. Definition x := 0. End NS182. End NS182. Export NS182. Module NS183. Module NS183. Definition x := 0. End NS183. End NS183. Export NS183. Module NS184. Module NS184. Definition x := 0. End NS184. End NS184. Export NS184. Module NS185. Module NS185. Definition x := 0. End NS185. End NS185. Export NS185. Module NS186. Module NS186. Definition x := 0. End NS186. End NS186. Export NS186. Module NS187. Module NS187. Definition x := 0. End NS187. End NS187. Export NS187. Module NS188. Module NS188. Definition x := 0. End NS188. End NS188. Export NS188. Module NS189. Module NS189. Definition x := 0. End NS189. End NS189. Export NS189. Module NS190. Module NS190. Definition x := 0. End NS190. End NS190. Export NS190. Module NS191. Module NS191. Definition x := 0. End NS191. End NS191. Export NS191. Module NS192. Module NS192. Definition x := 0. End NS192. End NS192. Export NS192. Module NS193. Module NS193. Definition x := 0. End NS193. End NS193. Export NS193. Module NS194. Module NS194. Definition x := 0. End NS194. End NS194. Export NS194. Module NS195. Module NS195. Definition x := 0. End NS195. End NS195. Export NS195. Module NS196. Module NS196. Definition x := 0. End NS196. End NS196. Export NS196. Module NS197. Module NS197. Definition x := 0. End NS197. End NS197. Export NS197. Module NS198. Module NS198. Definition x := 0. End NS198. End NS198. Export NS198. Module NS199. Module NS199. Definition x := 0. End NS199. End NS199. Export NS199. Module NS200. Module NS200. Definition x := 0. End NS200. End NS200. Export NS200. Module NS201. Module NS201. Definition x := 0. End NS201. End NS201. Export NS201. Module NS202. Module NS202. Definition x := 0. End NS202. End NS202. Export NS202. Module NS203. Module NS203. Definition x := 0. End NS203. End NS203. Export NS203. Module NS204. Module NS204. Definition x := 0. End NS204. End NS204. Export NS204. Module NS205. Module NS205. Definition x := 0. End NS205. End NS205. Export NS205. Module NS206. Module NS206. Definition x := 0. End NS206. End NS206. Export NS206. Module NS207. Module NS207. Definition x := 0. End NS207. End NS207. Export NS207. Module NS208. Module NS208. Definition x := 0. End NS208. End NS208. Export NS208. Module NS209. Module NS209. Definition x := 0. End NS209. End NS209. Export NS209. Module NS210. Module NS210. Definition x := 0. End NS210. End NS210. Export NS210. Module NS211. Module NS211. Definition x := 0. End NS211. End NS211. Export NS211. Module NS212. Module NS212. Definition x := 0. End NS212. End NS212. Export NS212. Module NS213. Module NS213. Definition x := 0. End NS213. End NS213. Export NS213. Module NS214. Module NS214. Definition x := 0. End NS214. End NS214. Export NS214. Module NS215. Module NS215. Definition x := 0. End NS215. End NS215. Export NS215. Module NS216. Module NS216. Definition x := 0. End NS216. End NS216. Export NS216. Module NS217. Module NS217. Definition x := 0. End NS217. End NS217. Export NS217. Module NS218. Module NS218. Definition x := 0. End NS218. End NS218. Export NS218. Module NS219. Module NS219. Definition x := 0. End NS219. End NS219. Export NS219. Module NS220. Module NS220. Definition x := 0. End NS220. End NS220. Export NS220. Module NS221. Module NS221. Definition x := 0. End NS221. End NS221. Export NS221. Module NS222. Module NS222. Definition x := 0. End NS222. End NS222. Export NS222. Module NS223. Module NS223. Definition x := 0. End NS223. End NS223. Export NS223. Module NS224. Module NS224. Definition x := 0. End NS224. End NS224. Export NS224. Module NS225. Module NS225. Definition x := 0. End NS225. End NS225. Export NS225. Module NS226. Module NS226. Definition x := 0. End NS226. End NS226. Export NS226. Module NS227. Module NS227. Definition x := 0. End NS227. End NS227. Export NS227. Module NS228. Module NS228. Definition x := 0. End NS228. End NS228. Export NS228. Module NS229. Module NS229. Definition x := 0. End NS229. End NS229. Export NS229. Module NS230. Module NS230. Definition x := 0. End NS230. End NS230. Export NS230. Module NS231. Module NS231. Definition x := 0. End NS231. End NS231. Export NS231. Module NS232. Module NS232. Definition x := 0. End NS232. End NS232. Export NS232. Module NS233. Module NS233. Definition x := 0. End NS233. End NS233. Export NS233. Module NS234. Module NS234. Definition x := 0. End NS234. End NS234. Export NS234. Module NS235. Module NS235. Definition x := 0. End NS235. End NS235. Export NS235. Module NS236. Module NS236. Definition x := 0. End NS236. End NS236. Export NS236. Module NS237. Module NS237. Definition x := 0. End NS237. End NS237. Export NS237. Module NS238. Module NS238. Definition x := 0. End NS238. End NS238. Export NS238. Module NS239. Module NS239. Definition x := 0. End NS239. End NS239. Export NS239. Module NS240. Module NS240. Definition x := 0. End NS240. End NS240. Export NS240. Module NS241. Module NS241. Definition x := 0. End NS241. End NS241. Export NS241. Module NS242. Module NS242. Definition x := 0. End NS242. End NS242. Export NS242. Module NS243. Module NS243. Definition x := 0. End NS243. End NS243. Export NS243. Module NS244. Module NS244. Definition x := 0. End NS244. End NS244. Export NS244. Module NS245. Module NS245. Definition x := 0. End NS245. End NS245. Export NS245. Module NS246. Module NS246. Definition x := 0. End NS246. End NS246. Export NS246. Module NS247. Module NS247. Definition x := 0. End NS247. End NS247. Export NS247. Module NS248. Module NS248. Definition x := 0. End NS248. End NS248. Export NS248. Module NS249. Module NS249. Definition x := 0. End NS249. End NS249. Export NS249. Module NS250. Module NS250. Definition x := 0. End NS250. End NS250. Export NS250. Module NS251. Module NS251. Definition x := 0. End NS251. End NS251. Export NS251. Module NS252. Module NS252. Definition x := 0. End NS252. End NS252. Export NS252. Module NS253. Module NS253. Definition x := 0. End NS253. End NS253. Export NS253. Module NS254. Module NS254. Definition x := 0. End NS254. End NS254. Export NS254. Module NS255. Module NS255. Definition x := 0. End NS255. End NS255. Export NS255. Module NS256. Module NS256. Definition x := 0. End NS256. End NS256. Export NS256. Module NS257. Module NS257. Definition x := 0. End NS257. End NS257. Export NS257. Module NS258. Module NS258. Definition x := 0. End NS258. End NS258. Export NS258. Module NS259. Module NS259. Definition x := 0. End NS259. End NS259. Export NS259. Module NS260. Module NS260. Definition x := 0. End NS260. End NS260. Export NS260. Module NS261. Module NS261. Definition x := 0. End NS261. End NS261. Export NS261. Module NS262. Module NS262. Definition x := 0. End NS262. End NS262. Export NS262. Module NS263. Module NS263. Definition x := 0. End NS263. End NS263. Export NS263. Module NS264. Module NS264. Definition x := 0. End NS264. End NS264. Export NS264. Module NS265. Module NS265. Definition x := 0. End NS265. End NS265. Export NS265. Module NS266. Module NS266. Definition x := 0. End NS266. End NS266. Export NS266. Module NS267. Module NS267. Definition x := 0. End NS267. End NS267. Export NS267. Module NS268. Module NS268. Definition x := 0. End NS268. End NS268. Export NS268. Module NS269. Module NS269. Definition x := 0. End NS269. End NS269. Export NS269. Module NS270. Module NS270. Definition x := 0. End NS270. End NS270. Export NS270. Module NS271. Module NS271. Definition x := 0. End NS271. End NS271. Export NS271. Module NS272. Module NS272. Definition x := 0. End NS272. End NS272. Export NS272. Module NS273. Module NS273. Definition x := 0. End NS273. End NS273. Export NS273. Module NS274. Module NS274. Definition x := 0. End NS274. End NS274. Export NS274. Module NS275. Module NS275. Definition x := 0. End NS275. End NS275. Export NS275. Module NS276. Module NS276. Definition x := 0. End NS276. End NS276. Export NS276. Module NS277. Module NS277. Definition x := 0. End NS277. End NS277. Export NS277. Module NS278. Module NS278. Definition x := 0. End NS278. End NS278. Export NS278. Module NS279. Module NS279. Definition x := 0. End NS279. End NS279. Export NS279. Module NS280. Module NS280. Definition x := 0. End NS280. End NS280. Export NS280. Module NS281. Module NS281. Definition x := 0. End NS281. End NS281. Export NS281. Module NS282. Module NS282. Definition x := 0. End NS282. End NS282. Export NS282. Module NS283. Module NS283. Definition x := 0. End NS283. End NS283. Export NS283. Module NS284. Module NS284. Definition x := 0. End NS284. End NS284. Export NS284. Module NS285. Module NS285. Definition x := 0. End NS285. End NS285. Export NS285. Module NS286. Module NS286. Definition x := 0. End NS286. End NS286. Export NS286. Module NS287. Module NS287. Definition x := 0. End NS287. End NS287. Export NS287. Module NS288. Module NS288. Definition x := 0. End NS288. End NS288. Export NS288. Module NS289. Module NS289. Definition x := 0. End NS289. End NS289. Export NS289. Module NS290. Module NS290. Definition x := 0. End NS290. End NS290. Export NS290. Module NS291. Module NS291. Definition x := 0. End NS291. End NS291. Export NS291. Module NS292. Module NS292. Definition x := 0. End NS292. End NS292. Export NS292. Module NS293. Module NS293. Definition x := 0. End NS293. End NS293. Export NS293. Module NS294. Module NS294. Definition x := 0. End NS294. End NS294. Export NS294. Module NS295. Module NS295. Definition x := 0. End NS295. End NS295. Export NS295. Module NS296. Module NS296. Definition x := 0. End NS296. End NS296. Export NS296. Module NS297. Module NS297. Definition x := 0. End NS297. End NS297. Export NS297. Module NS298. Module NS298. Definition x := 0. End NS298. End NS298. Export NS298. Module NS299. Module NS299. Definition x := 0. End NS299. End NS299. Export NS299. Module NS300. Module NS300. Definition x := 0. End NS300. End NS300. Export NS300. Module NS301. Module NS301. Definition x := 0. End NS301. End NS301. Export NS301. Module NS302. Module NS302. Definition x := 0. End NS302. End NS302. Export NS302. Module NS303. Module NS303. Definition x := 0. End NS303. End NS303. Export NS303. Module NS304. Module NS304. Definition x := 0. End NS304. End NS304. Export NS304. Module NS305. Module NS305. Definition x := 0. End NS305. End NS305. Export NS305. Module NS306. Module NS306. Definition x := 0. End NS306. End NS306. Export NS306. Module NS307. Module NS307. Definition x := 0. End NS307. End NS307. Export NS307. Module NS308. Module NS308. Definition x := 0. End NS308. End NS308. Export NS308. Module NS309. Module NS309. Definition x := 0. End NS309. End NS309. Export NS309. Module NS310. Module NS310. Definition x := 0. End NS310. End NS310. Export NS310. Module NS311. Module NS311. Definition x := 0. End NS311. End NS311. Export NS311. Module NS312. Module NS312. Definition x := 0. End NS312. End NS312. Export NS312. Module NS313. Module NS313. Definition x := 0. End NS313. End NS313. Export NS313. Module NS314. Module NS314. Definition x := 0. End NS314. End NS314. Export NS314. Module NS315. Module NS315. Definition x := 0. End NS315. End NS315. Export NS315. Module NS316. Module NS316. Definition x := 0. End NS316. End NS316. Export NS316. Module NS317. Module NS317. Definition x := 0. End NS317. End NS317. Export NS317. Module NS318. Module NS318. Definition x := 0. End NS318. End NS318. Export NS318. Module NS319. Module NS319. Definition x := 0. End NS319. End NS319. Export NS319. Module NS320. Module NS320. Definition x := 0. End NS320. End NS320. Export NS320. Module NS321. Module NS321. Definition x := 0. End NS321. End NS321. Export NS321. Module NS322. Module NS322. Definition x := 0. End NS322. End NS322. Export NS322. Module NS323. Module NS323. Definition x := 0. End NS323. End NS323. Export NS323. Module NS324. Module NS324. Definition x := 0. End NS324. End NS324. Export NS324. Module NS325. Module NS325. Definition x := 0. End NS325. End NS325. Export NS325. Module NS326. Module NS326. Definition x := 0. End NS326. End NS326. Export NS326. Module NS327. Module NS327. Definition x := 0. End NS327. End NS327. Export NS327. Module NS328. Module NS328. Definition x := 0. End NS328. End NS328. Export NS328. Module NS329. Module NS329. Definition x := 0. End NS329. End NS329. Export NS329. Module NS330. Module NS330. Definition x := 0. End NS330. End NS330. Export NS330. Module NS331. Module NS331. Definition x := 0. End NS331. End NS331. Export NS331. Module NS332. Module NS332. Definition x := 0. End NS332. End NS332. Export NS332. Module NS333. Module NS333. Definition x := 0. End NS333. End NS333. Export NS333. Module NS334. Module NS334. Definition x := 0. End NS334. End NS334. Export NS334. Module NS335. Module NS335. Definition x := 0. End NS335. End NS335. Export NS335. Module NS336. Module NS336. Definition x := 0. End NS336. End NS336. Export NS336. Module NS337. Module NS337. Definition x := 0. End NS337. End NS337. Export NS337. Module NS338. Module NS338. Definition x := 0. End NS338. End NS338. Export NS338. Module NS339. Module NS339. Definition x := 0. End NS339. End NS339. Export NS339. Module NS340. Module NS340. Definition x := 0. End NS340. End NS340. Export NS340. Module NS341. Module NS341. Definition x := 0. End NS341. End NS341. Export NS341. Module NS342. Module NS342. Definition x := 0. End NS342. End NS342. Export NS342. Module NS343. Module NS343. Definition x := 0. End NS343. End NS343. Export NS343. Module NS344. Module NS344. Definition x := 0. End NS344. End NS344. Export NS344. Module NS345. Module NS345. Definition x := 0. End NS345. End NS345. Export NS345. Module NS346. Module NS346. Definition x := 0. End NS346. End NS346. Export NS346. Module NS347. Module NS347. Definition x := 0. End NS347. End NS347. Export NS347. Module NS348. Module NS348. Definition x := 0. End NS348. End NS348. Export NS348. Module NS349. Module NS349. Definition x := 0. End NS349. End NS349. Export NS349. Module NS350. Module NS350. Definition x := 0. End NS350. End NS350. Export NS350. Module NS351. Module NS351. Definition x := 0. End NS351. End NS351. Export NS351. Module NS352. Module NS352. Definition x := 0. End NS352. End NS352. Export NS352. Module NS353. Module NS353. Definition x := 0. End NS353. End NS353. Export NS353. Module NS354. Module NS354. Definition x := 0. End NS354. End NS354. Export NS354. Module NS355. Module NS355. Definition x := 0. End NS355. End NS355. Export NS355. Module NS356. Module NS356. Definition x := 0. End NS356. End NS356. Export NS356. Module NS357. Module NS357. Definition x := 0. End NS357. End NS357. Export NS357. Module NS358. Module NS358. Definition x := 0. End NS358. End NS358. Export NS358. Module NS359. Module NS359. Definition x := 0. End NS359. End NS359. Export NS359. Module NS360. Module NS360. Definition x := 0. End NS360. End NS360. Export NS360. Module NS361. Module NS361. Definition x := 0. End NS361. End NS361. Export NS361. Module NS362. Module NS362. Definition x := 0. End NS362. End NS362. Export NS362. Module NS363. Module NS363. Definition x := 0. End NS363. End NS363. Export NS363. Module NS364. Module NS364. Definition x := 0. End NS364. End NS364. Export NS364. Module NS365. Module NS365. Definition x := 0. End NS365. End NS365. Export NS365. Module NS366. Module NS366. Definition x := 0. End NS366. End NS366. Export NS366. Module NS367. Module NS367. Definition x := 0. End NS367. End NS367. Export NS367. Module NS368. Module NS368. Definition x := 0. End NS368. End NS368. Export NS368. Module NS369. Module NS369. Definition x := 0. End NS369. End NS369. Export NS369. Module NS370. Module NS370. Definition x := 0. End NS370. End NS370. Export NS370. Module NS371. Module NS371. Definition x := 0. End NS371. End NS371. Export NS371. Module NS372. Module NS372. Definition x := 0. End NS372. End NS372. Export NS372. Module NS373. Module NS373. Definition x := 0. End NS373. End NS373. Export NS373. Module NS374. Module NS374. Definition x := 0. End NS374. End NS374. Export NS374. Module NS375. Module NS375. Definition x := 0. End NS375. End NS375. Export NS375. Module NS376. Module NS376. Definition x := 0. End NS376. End NS376. Export NS376. Module NS377. Module NS377. Definition x := 0. End NS377. End NS377. Export NS377. Module NS378. Module NS378. Definition x := 0. End NS378. End NS378. Export NS378. Module NS379. Module NS379. Definition x := 0. End NS379. End NS379. Export NS379. Module NS380. Module NS380. Definition x := 0. End NS380. End NS380. Export NS380. Module NS381. Module NS381. Definition x := 0. End NS381. End NS381. Export NS381. Module NS382. Module NS382. Definition x := 0. End NS382. End NS382. Export NS382. Module NS383. Module NS383. Definition x := 0. End NS383. End NS383. Export NS383. Module NS384. Module NS384. Definition x := 0. End NS384. End NS384. Export NS384. Module NS385. Module NS385. Definition x := 0. End NS385. End NS385. Export NS385. Module NS386. Module NS386. Definition x := 0. End NS386. End NS386. Export NS386. Module NS387. Module NS387. Definition x := 0. End NS387. End NS387. Export NS387. Module NS388. Module NS388. Definition x := 0. End NS388. End NS388. Export NS388. Module NS389. Module NS389. Definition x := 0. End NS389. End NS389. Export NS389. Module NS390. Module NS390. Definition x := 0. End NS390. End NS390. Export NS390. Module NS391. Module NS391. Definition x := 0. End NS391. End NS391. Export NS391. Module NS392. Module NS392. Definition x := 0. End NS392. End NS392. Export NS392. Module NS393. Module NS393. Definition x := 0. End NS393. End NS393. Export NS393. Module NS394. Module NS394. Definition x := 0. End NS394. End NS394. Export NS394. Module NS395. Module NS395. Definition x := 0. End NS395. End NS395. Export NS395. Module NS396. Module NS396. Definition x := 0. End NS396. End NS396. Export NS396. Module NS397. Module NS397. Definition x := 0. End NS397. End NS397. Export NS397. Module NS398. Module NS398. Definition x := 0. End NS398. End NS398. Export NS398. Module NS399. Module NS399. Definition x := 0. End NS399. End NS399. Export NS399. Module NS400. Module NS400. Definition x := 0. End NS400. End NS400. Export NS400. Module NS401. Module NS401. Definition x := 0. End NS401. End NS401. Export NS401. Module NS402. Module NS402. Definition x := 0. End NS402. End NS402. Export NS402. Module NS403. Module NS403. Definition x := 0. End NS403. End NS403. Export NS403. Module NS404. Module NS404. Definition x := 0. End NS404. End NS404. Export NS404. Module NS405. Module NS405. Definition x := 0. End NS405. End NS405. Export NS405. Module NS406. Module NS406. Definition x := 0. End NS406. End NS406. Export NS406. Module NS407. Module NS407. Definition x := 0. End NS407. End NS407. Export NS407. Module NS408. Module NS408. Definition x := 0. End NS408. End NS408. Export NS408. Module NS409. Module NS409. Definition x := 0. End NS409. End NS409. Export NS409. Module NS410. Module NS410. Definition x := 0. End NS410. End NS410. Export NS410. Module NS411. Module NS411. Definition x := 0. End NS411. End NS411. Export NS411. Module NS412. Module NS412. Definition x := 0. End NS412. End NS412. Export NS412. Module NS413. Module NS413. Definition x := 0. End NS413. End NS413. Export NS413. Module NS414. Module NS414. Definition x := 0. End NS414. End NS414. Export NS414. Module NS415. Module NS415. Definition x := 0. End NS415. End NS415. Export NS415. Module NS416. Module NS416. Definition x := 0. End NS416. End NS416. Export NS416. Module NS417. Module NS417. Definition x := 0. End NS417. End NS417. Export NS417. Module NS418. Module NS418. Definition x := 0. End NS418. End NS418. Export NS418. Module NS419. Module NS419. Definition x := 0. End NS419. End NS419. Export NS419. Module NS420. Module NS420. Definition x := 0. End NS420. End NS420. Export NS420. Module NS421. Module NS421. Definition x := 0. End NS421. End NS421. Export NS421. Module NS422. Module NS422. Definition x := 0. End NS422. End NS422. Export NS422. Module NS423. Module NS423. Definition x := 0. End NS423. End NS423. Export NS423. Module NS424. Module NS424. Definition x := 0. End NS424. End NS424. Export NS424. Module NS425. Module NS425. Definition x := 0. End NS425. End NS425. Export NS425. Module NS426. Module NS426. Definition x := 0. End NS426. End NS426. Export NS426. Module NS427. Module NS427. Definition x := 0. End NS427. End NS427. Export NS427. Module NS428. Module NS428. Definition x := 0. End NS428. End NS428. Export NS428. Module NS429. Module NS429. Definition x := 0. End NS429. End NS429. Export NS429. Module NS430. Module NS430. Definition x := 0. End NS430. End NS430. Export NS430. Module NS431. Module NS431. Definition x := 0. End NS431. End NS431. Export NS431. Module NS432. Module NS432. Definition x := 0. End NS432. End NS432. Export NS432. Module NS433. Module NS433. Definition x := 0. End NS433. End NS433. Export NS433. Module NS434. Module NS434. Definition x := 0. End NS434. End NS434. Export NS434. Module NS435. Module NS435. Definition x := 0. End NS435. End NS435. Export NS435. Module NS436. Module NS436. Definition x := 0. End NS436. End NS436. Export NS436. Module NS437. Module NS437. Definition x := 0. End NS437. End NS437. Export NS437. Module NS438. Module NS438. Definition x := 0. End NS438. End NS438. Export NS438. Module NS439. Module NS439. Definition x := 0. End NS439. End NS439. Export NS439. Module NS440. Module NS440. Definition x := 0. End NS440. End NS440. Export NS440. Module NS441. Module NS441. Definition x := 0. End NS441. End NS441. Export NS441. Module NS442. Module NS442. Definition x := 0. End NS442. End NS442. Export NS442. Module NS443. Module NS443. Definition x := 0. End NS443. End NS443. Export NS443. Module NS444. Module NS444. Definition x := 0. End NS444. End NS444. Export NS444. Module NS445. Module NS445. Definition x := 0. End NS445. End NS445. Export NS445. Module NS446. Module NS446. Definition x := 0. End NS446. End NS446. Export NS446. Module NS447. Module NS447. Definition x := 0. End NS447. End NS447. Export NS447. Module NS448. Module NS448. Definition x := 0. End NS448. End NS448. Export NS448. Module NS449. Module NS449. Definition x := 0. End NS449. End NS449. Export NS449. Module NS450. Module NS450. Definition x := 0. End NS450. End NS450. Export NS450. Module NS451. Module NS451. Definition x := 0. End NS451. End NS451. Export NS451. Module NS452. Module NS452. Definition x := 0. End NS452. End NS452. Export NS452. Module NS453. Module NS453. Definition x := 0. End NS453. End NS453. Export NS453. Module NS454. Module NS454. Definition x := 0. End NS454. End NS454. Export NS454. Module NS455. Module NS455. Definition x := 0. End NS455. End NS455. Export NS455. Module NS456. Module NS456. Definition x := 0. End NS456. End NS456. Export NS456. Module NS457. Module NS457. Definition x := 0. End NS457. End NS457. Export NS457. Module NS458. Module NS458. Definition x := 0. End NS458. End NS458. Export NS458. Module NS459. Module NS459. Definition x := 0. End NS459. End NS459. Export NS459. Module NS460. Module NS460. Definition x := 0. End NS460. End NS460. Export NS460. Module NS461. Module NS461. Definition x := 0. End NS461. End NS461. Export NS461. Module NS462. Module NS462. Definition x := 0. End NS462. End NS462. Export NS462. Module NS463. Module NS463. Definition x := 0. End NS463. End NS463. Export NS463. Module NS464. Module NS464. Definition x := 0. End NS464. End NS464. Export NS464. Module NS465. Module NS465. Definition x := 0. End NS465. End NS465. Export NS465. Module NS466. Module NS466. Definition x := 0. End NS466. End NS466. Export NS466. Module NS467. Module NS467. Definition x := 0. End NS467. End NS467. Export NS467. Module NS468. Module NS468. Definition x := 0. End NS468. End NS468. Export NS468. Module NS469. Module NS469. Definition x := 0. End NS469. End NS469. Export NS469. Module NS470. Module NS470. Definition x := 0. End NS470. End NS470. Export NS470. Module NS471. Module NS471. Definition x := 0. End NS471. End NS471. Export NS471. Module NS472. Module NS472. Definition x := 0. End NS472. End NS472. Export NS472. Module NS473. Module NS473. Definition x := 0. End NS473. End NS473. Export NS473. Module NS474. Module NS474. Definition x := 0. End NS474. End NS474. Export NS474. Module NS475. Module NS475. Definition x := 0. End NS475. End NS475. Export NS475. Module NS476. Module NS476. Definition x := 0. End NS476. End NS476. Export NS476. Module NS477. Module NS477. Definition x := 0. End NS477. End NS477. Export NS477. Module NS478. Module NS478. Definition x := 0. End NS478. End NS478. Export NS478. Module NS479. Module NS479. Definition x := 0. End NS479. End NS479. Export NS479. Module NS480. Module NS480. Definition x := 0. End NS480. End NS480. Export NS480. Module NS481. Module NS481. Definition x := 0. End NS481. End NS481. Export NS481. Module NS482. Module NS482. Definition x := 0. End NS482. End NS482. Export NS482. Module NS483. Module NS483. Definition x := 0. End NS483. End NS483. Export NS483. Module NS484. Module NS484. Definition x := 0. End NS484. End NS484. Export NS484. Module NS485. Module NS485. Definition x := 0. End NS485. End NS485. Export NS485. Module NS486. Module NS486. Definition x := 0. End NS486. End NS486. Export NS486. Module NS487. Module NS487. Definition x := 0. End NS487. End NS487. Export NS487. Module NS488. Module NS488. Definition x := 0. End NS488. End NS488. Export NS488. Module NS489. Module NS489. Definition x := 0. End NS489. End NS489. Export NS489. Module NS490. Module NS490. Definition x := 0. End NS490. End NS490. Export NS490. Module NS491. Module NS491. Definition x := 0. End NS491. End NS491. Export NS491. Module NS492. Module NS492. Definition x := 0. End NS492. End NS492. Export NS492. Module NS493. Module NS493. Definition x := 0. End NS493. End NS493. Export NS493. Module NS494. Module NS494. Definition x := 0. End NS494. End NS494. Export NS494. Module NS495. Module NS495. Definition x := 0. End NS495. End NS495. Export NS495. Module NS496. Module NS496. Definition x := 0. End NS496. End NS496. Export NS496. Module NS497. Module NS497. Definition x := 0. End NS497. End NS497. Export NS497. Module NS498. Module NS498. Definition x := 0. End NS498. End NS498. Export NS498. Module NS499. Module NS499. Definition x := 0. End NS499. End NS499. Export NS499. Module NS500. Module NS500. Definition x := 0. End NS500. End NS500. Export NS500.coq-elpi-1.19.3/apps/NES/tests/test_NES_resolve.v000066400000000000000000000011351451177652200214740ustar00rootroot00000000000000From elpi.apps Require Import NES. NES.Begin A. Definition cats := 3. NES.End A. NES.Begin B. Definition dogs := 4. NES.End B. NES.Begin C. NES.Begin A. Definition bunnies := 42. NES.End A. Section more_bunnies. NES.Open A. Definition more_bunnies := bunnies. End more_bunnies. Section more_cats. NES.Open _.A. Definition more_cats := cats. End more_cats. Section more_dogs. NES.Open B. Definition more_dogs := dogs. End more_dogs. Section even_more_dogs. NES.Open _.B. Definition even_more_dogs := dogs. End even_more_dogs. NES.End C. coq-elpi-1.19.3/apps/NES/tests/test_module_namespace.v000066400000000000000000000001371451177652200226120ustar00rootroot00000000000000From elpi.apps Require Import NES. Module MyModule. End MyModule. Succeed NES.Begin MyModule. coq-elpi-1.19.3/apps/NES/theories/000077500000000000000000000000001451177652200165425ustar00rootroot00000000000000coq-elpi-1.19.3/apps/NES/theories/NES.v000066400000000000000000000043031451177652200173560ustar00rootroot00000000000000From elpi.apps.NES Extra Dependency "nes.elpi" as nes. From elpi Require Import elpi. Elpi Db NES.db lp:{{ pred open-ns o:string, o:list string. :name "open-ns:begin" open-ns _ _ :- fail. typeabbrev path (list string). :index (2) pred ns o:path, o:modpath. }}. Elpi Command NES.Status. Elpi Accumulate Db NES.db. Elpi Accumulate File nes. Elpi Accumulate lp:{{ main _ :- coq.say "NES: current namespace" {nes.current-path}, std.findall (ns Y_ Z_) NS, coq.say "NES: registered namespaces" NS. }}. Elpi Typecheck. Elpi Export NES.Status. Elpi Command NES.Begin. Elpi Accumulate File nes. Elpi Accumulate lp:{{ main [str NS] :- nes.begin-path {nes.string->non-empty-ns NS} _. main _ :- coq.error "usage: NES.Begin ". }}. Elpi Accumulate Db NES.db. Elpi Typecheck. Elpi Export NES.Begin. Elpi Command NES.End. Elpi Accumulate File nes. Elpi Accumulate lp:{{ main [str NS] :- nes.end-path {nes.string->non-empty-ns NS} _. main _ :- coq.error "usage: NES.End ". }}. Elpi Accumulate Db NES.db. Elpi Typecheck. Elpi Export NES.End. Elpi Command NES.Open. Elpi Accumulate Db NES.db. Elpi Accumulate File nes. Elpi Accumulate lp:{{ main [str NS] :- nes.open-path {nes.resolve NS}. main _ :- coq.error "usage: NES.Open ". }}. Elpi Typecheck. Elpi Export NES.Open. (* List the contents a namespace *) Elpi Command NES.List. Elpi Accumulate Db NES.db. Elpi Accumulate File nes. Elpi Accumulate lp:{{ pred pp-gref i:gref, o:coq.pp. pp-gref GR PP :- coq.term->pp (global GR) PP. main [str NS] :- nes.print-path {nes.resolve NS} pp-gref. main _ :- coq.error "usage: NES.List ". }}. Elpi Typecheck. Elpi Export NES.List. (* NES.List with types *) Elpi Command NES.Print. Elpi Accumulate Db NES.db. Elpi Accumulate File nes. Elpi Accumulate lp:{{ pred pp-gref i:gref, o:coq.pp. pp-gref GR PP :- std.do! [ coq.env.typeof GR Ty, PP = coq.pp.box (coq.pp.hov 2) [ {coq.term->pp (global GR)}, coq.pp.str " :", coq.pp.spc, {coq.term->pp Ty}, ], ]. main [str NS] :- nes.print-path {nes.resolve NS} pp-gref. main _ :- coq.error "usage: NES.Print ". }}. Elpi Typecheck. Elpi Export NES.Print. coq-elpi-1.19.3/apps/README.md000066400000000000000000000005141451177652200155520ustar00rootroot00000000000000## Applications written in Coq-Elpi ### Derive Given an inductive type declaration it synthesizes a bunch of useful stuff such as proved equality tests, projections, parametricity relations. ### Eltac A toy set of tactics implemented in Elpi. ### NES A Namespace Emulation System. ### Locker A kit to lock definitions hard. coq-elpi-1.19.3/apps/coercion/000077500000000000000000000000001451177652200160745ustar00rootroot00000000000000coq-elpi-1.19.3/apps/coercion/Makefile000066400000000000000000000022501451177652200175330ustar00rootroot00000000000000# detection of coq ifeq "$(COQBIN)" "" COQBIN := $(shell which coqc >/dev/null 2>&1 && dirname `which coqc`) endif ifeq "$(COQBIN)" "" $(error Coq not found, make sure it is installed in your PATH or set COQBIN) else $(info Using coq found in $(COQBIN), from COQBIN or PATH) endif export COQBIN := $(COQBIN)/ all: build test build: Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq test: Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq theories/%.vo: force @$(MAKE) --no-print-directory -f Makefile.coq $@ tests/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ examples/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ Makefile.coq Makefile.coq.conf: _CoqProject @$(COQBIN)/coq_makefile -f _CoqProject -o Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq .merlin Makefile.test.coq Makefile.test.coq.conf: _CoqProject.test @$(COQBIN)/coq_makefile -f _CoqProject.test -o Makefile.test.coq clean: Makefile.coq Makefile.test.coq @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.19.3/apps/coercion/Makefile.coq.local000066400000000000000000000001251451177652200214040ustar00rootroot00000000000000CAMLPKGS+= -package coq-elpi.elpi OCAMLPATH:=../../src/:$(OCAMLPATH) export OCAMLPATHcoq-elpi-1.19.3/apps/coercion/README.md000066400000000000000000000037731451177652200173650ustar00rootroot00000000000000# Coercion The `coercion` app enables to program Coq coercions in Elpi. This app is experimental. ## The coercion predicate The `coercion` predicate lives in the database `coercion.db` ```elpi % [coercion Ctx V Inferred Expected Res] is queried to cast V to Res % - [Ctx] is the context % - [V] is the value to be coerced % - [Inferred] is the type of [V] % - [Expected] is the type [V] should be coerced to % - [Res] is the result (of type [Expected]) pred coercion i:goal-ctx, i:term, i:term, i:term, o:term. ``` By addings rules for this predicate one can recover from a type error, that is when `Inferred` and `Expected` are not unifiable. ## Simple example of coercion This example maps `True : Prop` to `true : bool`, which is a function you cannot express in type theory, hence in the standard Coercion system. ```coq From elpi.apps Require Import coercion. From Coq Require Import Bool. Elpi Accumulate coercion.db lp:{{ coercion _ {{ True }} {{ Prop }} {{ bool }} {{ true }}. coercion _ {{ False }} {{ Prop }} {{ bool }} {{ false }}. }}. Elpi Typecheck coercion. (* checks the elpi program is OK *) Check True && False. ``` ## Example of coercion with proof automation This coercion enriches `x : T` to a `{x : T | P x}` by using `my_solver` to prove `P x`. ```coq From elpi.apps Require Import coercion. From Coq Require Import Arith ssreflect. Ltac my_solver := trivial with arith. Elpi Accumulate coercion.db lp:{{ coercion _ X Ty {{ @sig lp:Ty lp:P }} Solution :- std.do! [ % we unfold letins since the solver is dumb and the `as` in the second % example introduces a letin (pi a b b1\ copy a b :- def a _ _ b, copy b b1) => copy X X1, % we build the solution Solution = {{ @exist lp:Ty lp:P lp:X1 _ }}, % we call the solver coq.ltac.collect-goals Solution [G] [], coq.ltac.open (coq.ltac.call-ltac1 "my_solver") G [], ]. }}. Elpi Typecheck coercion. Goal {x : nat | x > 0}. apply: 3. Qed. Definition ensure_pos n : {x : nat | x > 0} := match n with | O => 1 | S x as y => y end. ``` coq-elpi-1.19.3/apps/coercion/_CoqProject000066400000000000000000000004001451177652200202210ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps -R theories elpi.apps src/coq_elpi_coercion_hook.mlg src/elpi_coercion_plugin.mlpack -I src/ src/META.coq-elpi-coercion theories/coercion.v coq-elpi-1.19.3/apps/coercion/_CoqProject.test000066400000000000000000000003771451177652200212140ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps -R theories elpi.apps -R tests elpi.apps.coercion.tests tests/test_coercion.v tests/test_coercion_open.v tests/test_coercion_load.v -I src coq-elpi-1.19.3/apps/coercion/src/000077500000000000000000000000001451177652200166635ustar00rootroot00000000000000coq-elpi-1.19.3/apps/coercion/src/META.coq-elpi-coercion000066400000000000000000000004431451177652200226440ustar00rootroot00000000000000 package "plugin" ( directory = "." requires = "coq-core.plugins.ltac coq-elpi.elpi" archive(byte) = "elpi_coercion_plugin.cma" archive(native) = "elpi_coercion_plugin.cmxa" plugin(byte) = "elpi_coercion_plugin.cma" plugin(native) = "elpi_coercion_plugin.cmxs" ) directory = "." coq-elpi-1.19.3/apps/coercion/src/coq_elpi_coercion_hook.mlg000066400000000000000000000041251451177652200240620ustar00rootroot00000000000000DECLARE PLUGIN "coq-elpi-coercion.plugin" { open Elpi open Elpi_plugin open Coq_elpi_arg_syntax open Coq_elpi_vernacular let elpi_coercion_hook program env sigma ~flags v ~inferred ~expected = let loc = API.Ast.Loc.initial "(unknown)" in let atts = [] in let sigma, goal = Evarutil.new_evar env sigma expected in let goal_evar, _ = EConstr.destEvar sigma goal in let query ~depth state = let state, (loc, q), gls = Coq_elpi_HOAS.goals2query sigma [goal_evar] loc ~main:(Coq_elpi_HOAS.Solve [v; inferred]) ~in_elpi_tac_arg:Coq_elpi_arg_HOAS.in_elpi_tac_econstr ~depth state in let state, qatts = atts2impl loc ~depth state atts q in let state = API.State.set Coq_elpi_builtins.tactic_mode state true in state, (loc, qatts), gls in let cprogram, _ = get_and_compile program in match run ~static_check:false cprogram (`Fun query) with | API.Execute.Success solution -> let gls = Evar.Set.singleton goal_evar in let sigma, _, _ = Coq_elpi_HOAS.solution2evd sigma solution gls in if Evd.is_defined sigma goal_evar then Some (sigma, goal) else None | API.Execute.NoMoreSteps | API.Execute.Failure -> None | exception (Coq_elpi_utils.LtacFail (level, msg)) -> None let add_coercion_hook = let coercion_hook_program = Summary.ref ~name:"elpi-coercion" None in let coercion_hook env sigma ~flags v ~inferred ~expected = match !coercion_hook_program with | None -> None | Some h -> elpi_coercion_hook h env sigma ~flags v ~inferred ~expected in let name = "elpi-coercion" in Coercion.register_hook ~name coercion_hook; let inCoercion = let cache program = coercion_hook_program := Some program; Coercion.activate_hook ~name in let open Libobject in declare_object @@ superglobal_object_nodischarge "ELPI-COERCION" ~cache ~subst:None in fun program -> Lib.add_leaf (inCoercion program) } VERNAC COMMAND EXTEND ElpiCoercion CLASSIFIED AS SIDEFF | #[ atts = any_attribute ] [ "Elpi" "CoercionFallbackTactic" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in add_coercion_hook (snd p) } ENDcoq-elpi-1.19.3/apps/coercion/src/elpi_coercion_plugin.mlpack000066400000000000000000000000261451177652200242420ustar00rootroot00000000000000Coq_elpi_coercion_hookcoq-elpi-1.19.3/apps/coercion/tests/000077500000000000000000000000001451177652200172365ustar00rootroot00000000000000coq-elpi-1.19.3/apps/coercion/tests/test_coercion.v000066400000000000000000000013401451177652200222630ustar00rootroot00000000000000From elpi.apps Require Import coercion. From Coq Require Import Bool. Elpi Accumulate coercion.db lp:{{ coercion _ {{ True }} {{ Prop }} {{ bool }} {{ true }}. coercion _ {{ False }} {{ Prop }} {{ bool }} {{ false }}. }}. Elpi Typecheck coercion. Check True && False. Parameter ringType : Type. Parameter ringType_sort : ringType -> Type. Parameter natmul : forall (R : ringType) (n : nat), (ringType_sort R). Elpi Accumulate coercion.db lp:{{ coercion _ N {{ nat }} {{ ringType_sort lp:R }} {{ natmul lp:R lp:N }} :- coq.typecheck R {{ ringType }} ok. }}. Elpi Typecheck coercion. Section TestNatMul. Variable R : ringType. Variable n : nat. Check natmul R n : ringType_sort R. Check n : ringType_sort R. End TestNatMul. coq-elpi-1.19.3/apps/coercion/tests/test_coercion_load.v000066400000000000000000000000621451177652200232620ustar00rootroot00000000000000Require Import test_coercion. Check True : bool. coq-elpi-1.19.3/apps/coercion/tests/test_coercion_open.v000066400000000000000000000012541451177652200233100ustar00rootroot00000000000000From elpi.apps Require Import coercion. From Coq Require Import Arith ssreflect. Ltac my_solver := trivial with arith. Elpi Accumulate coercion.db lp:{{ coercion _ X Ty {{ @sig lp:Ty lp:P }} Solution :- std.do! [ % we unfold letins since the solve is dumb (pi a b b1\ copy a b :- def a _ _ b, copy b b1) => copy X X1, % we build the solution Solution = {{ @exist lp:Ty lp:P lp:X1 _ }}, % we call the solver coq.ltac.collect-goals Solution [G] [], coq.ltac.open (coq.ltac.call-ltac1 "my_solver") G [], ]. }}. Elpi Typecheck coercion. Goal {x : nat | x > 0}. apply: 3. Qed. Definition add1 n : {x : nat | x > 0} := match n with | O => 1 | S x as y => y end. coq-elpi-1.19.3/apps/coercion/theories/000077500000000000000000000000001451177652200177165ustar00rootroot00000000000000coq-elpi-1.19.3/apps/coercion/theories/coercion.v000066400000000000000000000013041451177652200217040ustar00rootroot00000000000000Declare ML Module "coq-elpi-coercion.plugin". From elpi Require Import elpi. Elpi Db coercion.db lp:{{ % predicate [coercion Ctx V Inferred Expected Res] used to add new coercion, with % - [Ctx] is the context % - [V] is the value to be coerced % - [Inferred] is the type of [V] % - [Expected] is the type [V] should be coerced to % - [Res] is the result (of type [Expected]) % Be careful not to trigger coercion as this may loop. pred coercion i:goal-ctx, i:term, i:term, i:term, o:term. }}. Elpi Tactic coercion. Elpi Accumulate lp:{{ solve (goal Ctx _ Ty Sol [trm V, trm VTy]) _ :- coercion Ctx V VTy Ty Sol. }}. Elpi Accumulate Db coercion.db. Elpi Typecheck. Elpi CoercionFallbackTactic coercion. coq-elpi-1.19.3/apps/derive/000077500000000000000000000000001451177652200155515ustar00rootroot00000000000000coq-elpi-1.19.3/apps/derive/Makefile000066400000000000000000000023531451177652200172140ustar00rootroot00000000000000# detection of coq ifeq "$(COQBIN)" "" COQBIN := $(shell which coqc >/dev/null 2>&1 && dirname `which coqc`) endif ifeq "$(COQBIN)" "" $(error Coq not found, make sure it is installed in your PATH or set COQBIN) else $(info Using coq found in $(COQBIN), from COQBIN or PATH) endif export COQBIN := $(COQBIN)/ all: build test build: Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq test: Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq coverage: @$(MAKE) --no-print-directory -f Makefile.coq coverage theories/%.vo: force @$(MAKE) --no-print-directory -f Makefile.coq $@ tests/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ examples/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ Makefile.coq Makefile.coq.conf: _CoqProject @$(COQBIN)/coq_makefile -f _CoqProject -o Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq .merlin Makefile.test.coq Makefile.test.coq.conf: _CoqProject.test @$(COQBIN)/coq_makefile -f _CoqProject.test -o Makefile.test.coq clean: Makefile.coq Makefile.test.coq @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.19.3/apps/derive/Makefile.coq.local000066400000000000000000000021431451177652200210630ustar00rootroot00000000000000 coverage: @printf "====== %-10s\n" "test suite" @printf "inductives: %d\n" \ `grep -E "^ *(Inductive|Variant)" tests/test_derive_stdlib.v 2>/dev/null| wc -l` @printf "records: %d\n" \ `grep -E "^ *(Record|Structure)" tests/test_derive_stdlib.v 2>/dev/null| wc -l` @printf "definitions: %d\n" \ `grep -E "^ *(Fixpoint|Definition)" tests/test_derive_stdlib.v 2>/dev/null| wc -l` @for F in $(wildcard theories/derive/*.v); do\ D=`basename $$F .v`;\ D_=`echo $$D | sed 's/_/./'`;\ F=`mktemp`;\ if [ -e tests/test_$${D}.v ]; then\ (cat tests/test_$${D}.v | awk ' /Module Coverage/ { p = 1 } /End Coverage/ { p = 0 } { if(p == 1) { print }} ' ) > $$F ;\ N=`grep -E "^(Fail )?Elpi derive.$$D_" $$F 2>/dev/null| wc -l`;\ OK=`grep -E "^Elpi derive.$$D_" $$F 2>/dev/null| wc -l`;\ printf "====== %-10s (%2d/%-2d)\n" tests/test_$${D}.v $$OK $$N;\ grep -E "^Fail Elpi derive.$$D_" $$F | grep -vi expected 2>/dev/null;\ fi;\ done || true install-extra:: df="`$(COQMKFILE) -destination-of theories/derive/std.vo $(COQLIBS)`";\ install -m 0644 $(wildcard elpi/*.elpi) "$(COQLIBINSTALL)/$$df" coq-elpi-1.19.3/apps/derive/README.md000066400000000000000000000475031451177652200170410ustar00rootroot00000000000000# Derive The `derive` command automatically synthesizes a bunch of useful lemmas given an inductive type declaration. ## In a nutshell ```coq From elpi.apps Require Import derive.std. derive Inductive peano := Zero | Succ (p : peano). Print peano. (* Notation peano := peano.peano *) Print peano.peano. (* Inductive peano : Type := Zero : peano | Succ : peano -> peano *) Eval compute in peano.eqb Zero (Succ Zero). (* = false : bool *) About peano.eqb_OK. (* peano.eqb_OK : forall x1 x2 : peano, Bool.reflect (x1 = x2) (peano.eqb x1 x2) peano.eqb_OK is not universe polymorphic Arguments peano.eqb_OK x1 x2 peano.eqb_OK is opaque *) ``` See also [examples/usage.v](examples/usage.v) :warning: The line `From elpi.apps Require Import derive.std.` sets globally `Uniform Inductive Parameters`. See the [documentation of that option in the Coq reference manual](https://coq.inria.fr/refman/language/core/inductive.html#coq:flag.Uniform-Inductive-Parameters). ## Documentation Elpi's `derive` app is a little framework to register derivations. Currently there are 3 groups: - `derive.std` contains well tested derivations including: + `eqb` and `eqbOK` generate sound boolean equality test in linear time/space, see [Practical and sound equality tests, automatically](https://hal.inria.fr/hal-03800154) + `eqbOK` generates its soundness proof in linear time/space + `induction` generates deep induction principles, see [Stronger Induction Principles for Containers](http://drops.dagstuhl.de/opus/volltexte/2019/11084/) + `param1` and `param2` generate the unary and binary parametricity translations + `map` map over a container + `param1_functor` functoriality lemmas (map over the param1 translation) + `lens` and `lens_laws` generate lenses focusing on record fields and some equations governing setter/setters - `derive.legacy` contains derivations superseded by `std`: + `eq` and `eqOK` generate sound equality tests in quadratic time/space, see [Deriving proved equality tests in Coq-elpi](http://drops.dagstuhl.de/opus/volltexte/2019/11084/) - `derive.experimental` contains derivations not suitable for mainstream use: + `idx2inv` generates an inductive type where indexes are replaced by non uniform parameters and equations The `elpi/` directory contains the elpi files implementing various automatic derivation of terms. The corresponding .v files, defining the Coq commands, are in `theories/derive/`. Single steps of the derivation are available as separate commands. Only the main entry point `derive` comes with an handy syntax; the other commands have to be invoked mentioning `Elpi` and only accept an already declared inductive as input. ## Derivations
std (click to expand)

### `map` Map a container over its parameters. ```coq Elpi derive.map list. Check list_map : forall A B, (A -> B) -> list A -> list B. ``` ### `lens` See also [theories/derive/lens.v](theories/derive/lens.v) for the `Lens` definition and the support constants `view`, `set` and `over`. ```coq Record pa_record A := { f3 : peano; f4 : A; }. Elpi derive.lens pa_record. Check _f3 : forall A, Lens (pa_record A) (pa_record A) peano peano. ``` ### `lens_laws` See also [theories/derive/lens_laws.v](theories/derive/lens_laws.v) for the statements of the 4 laws (set_set, view_set, set_view, exchange). ```coq Elpi derive.lens_laws pa_record. Check _f3_view_set : forall A (r : pa_record A) x, view _f3 (set _f3 x r) = x. ``` ### `param1` Unary parametricity translation. ```coq Elpi derive.param1 nat. Print is_nat. (* Inductive is_nat : nat -> Type := | is_O : is_nat 0 | is_S : forall n : nat, is_nat n -> is_nat (S n) *) ``` ### `param1_functor` ```coq Elpi derive.param1.functor is_list. Check is_list_functor : forall A PA QA, (forall x, PA x -> QA x) -> forall l, is_list A PA l -> list A QA l. ``` ### `param1_trivial` ```coq Elpi derive.param1.trivial is_nat. Check is_nat_trivial : forall x : nat, { p : is_nat x & forall q, p = q }. Check is_nat_inhab : forall x : nat, is_nat x. ``` ### `induction` Induction principle for `T` based on `is_T` ```coq Elpi derive.induction list. Check list_induction : forall (A : Type) (PA : A -> Type) P, P (nil A) -> (forall x : A, PA x -> forall xs, P xs -> P (cons A x xs)) -> forall l, is_list A PA l -> P l. ``` ### `tag` The "name" of the constructor ```coq Elpi derive.tag peano. Check peano_tag : peano -> positive. ``` ### `fields` The types of the fields and the fields of each constructor ```coq Elpi derive.fields peano. Check peano_fields_t : positive -> Type. Check peano_fields : forall (n:peano), peano_fields_t (peano_tag n). Check peano_construct : forall (p: positive), peano_fields_t p -> Datatypes.option peano. Check peano_constructP : forall (n:peano), peano_construct (peano_tag n) (peano_fields n) = Datatypes.Some n. ``` ### `eqb` Equality test ```coq Elpi derive.eqb peano. Check peano_eqb : peano -> peano -> bool. ``` ### `eqbcorrect` Two directions of the soundness proof ```coq Elpi derive.eqbcorrect peano. Check peano_eqb_correct : forall n m, peano_eqb n m = true -> n = m. Check peano_eqb_refl : forall n, peano_eqb n n = true. ``` ### `eqbOK` The soundness proof ```coq Elpi derive.eqbOK peano. Check peano_eqb_OK : forall n m, reflect (n = m) (peano_eqb n m). ``` ### `param1_congr` Used by `param1_trivial`, not interesting. ```coq Elpi derive.param1.congr is_nat. Check is_Succ congr : forall x (px qx : is_nat x), px = qx -> is_Succ x px = is_Succ x qx. ```

legacy (click to expand)

See [Deriving proved equality tests in Coq-elpi: Stronger Induction Principles for Containers](http://drops.dagstuhl.de/opus/volltexte/2019/11084/) for a description of most of these components. ### `isK` Given an inductive type it generates for each constructor a function that tests if a term is a specific constructor. Example: ```coq Elpi derive.isK list. Print list_is_nil. (* list_is_nil = fun (A : Type) (i : list A) => match i with | nil => true | _ => false end *) ``` ### `projK` Given an inductive type it generates for each constructor `K` and argument `i` of this constructor a function extracting that argument (provided enough default values). ```coq Elpi derive.projK Vector.t. Check projcons1. (* projcons1 : forall (A : Type) (H : nat), A -> forall n : nat, Vector.t A n -> Vector.t A H -> A ``` The intended use is to perform injection, i.e. one aleady has a term of the shape `K args` and can just use these args to provide the default values. If the projected argument's type depends on the value of other arguments, then it is boxed using `existT`. ```coq Check projcons3. (* projcons3 : forall (A : Type) (H : nat), A -> forall n : nat, Vector.t A n -> Vector.t A H -> {i1 : nat & Vector.t A i1} *) ``` ### injection `injection H EqAB PL` given an equation `H` of type `EqAB` returns a list of equations `PL`. `EqAB` is expected to be of the form `K .. = K ..` for a constructor `K`. coverage: does not do the smart thing when the obtained equations are like `{ i : nat & Vector.t A i } = ...` in which case, given that `nat` is `eqType` one could obtain systematically the two equalities. Note: this is not a real derivation, since it generates no constant, but it a piece of code used by derivations. ### discriminate `discriminate H EqAB G PG` given an equation `H` of type `EqAB` and a goal `G` it provides a proof `PG`. It asserts that `EqAB` is of the form `K1 .. = K2 ..` when `K1` is a constructor different from `K2`. Note: this is not a real derivation, since it generates no constant, but it a piece of code used by derivations. ### `bcongr` We call a boolean congruence lemma an instance of the `reflect` predicate on a proposition `K x1..xn = K y1..yn` and a boolean expression `b1 && .. bn`. ```coq Elpi derive.bcongr list. Check nil_congr : forall A, reflect (@nil A = @nil A) true. Check cons_congr : forall A, forall (x y : A) b1, reflect (x = y) b1 -> forall (xs ys : list A) b2, reflect (xs = ys) b2 -> reflect (cons x xs = cons y ys) (b1 && b2). ``` ### `eq` Generates a boolean comparison function. ```coq Elpi derive.eq list. Check list_eq. (* list_eq : forall A : Type, (A -> A -> bool) -> list A -> list A -> bool *) ``` ### `eqK` Generates, for each constructor, the correctness lemma for the comparison function. ```coq Elpi derive.eqK list. Check eq_axiom_nil : forall A fa, axiom (list A) (list_eq A fa) (@nil A). Check eq_axiom_cons : forall A fa, forall x, axiom A fa x -> forall xs, axiom (list A) (list_eq A fa) xs -> axiom (list A) (list_eq A fa) (cons x xs). ``` ### `eqcorrect` Correctness of equality test using reified type information. ```coq Elpi derive.eqcorrect list. Check list_eq_correct : forall A f l, is_list A (eq_axiom A f) l -> eq_axiom (list A) (list_eq A f) l. ``` ### `eqOK` Correctness of equality test. ```coq Elpi derive.eqOK list. Check list_eq_OK : forall A f, (forall a, axiom A f a) -> (forall l, eq_axiom (list A) (list_eq A f) l). ``` ## Coverage This is the list of inductive types we use for testing, and the table with the result of each derivation (:sunny: = OK, :bug: = does not work but might, :cloud: = looks like this can't possible work) ```coq Inductive empty := . Inductive unit := tt. Inductive peano := Zero | Succ (n : peano). Inductive option A := None | Some (_ : A). Inductive pair A B := Comma (a : A) (b : B). Inductive seq A := Nil | Cons (x : A) (xs : seq A). Inductive rose (A : Type) := Leaf | Node (sib : seq (rose A)). Inductive nest A := NilN | ConsN (x : A) (xs : nest (pair A A)). Fail Inductive bush A := BNil | BCons (x : A) (xs : bush (bush A)). Inductive w A := via (f : A -> w A). Inductive vect A : peano -> Type := VNil : vect A Zero | VCons (x : A) n (xs : vect A n) : vect A (Succ n). Inductive dyn := box (T : Type) (t : T). Inductive zeta Sender (Receiver := Sender) := Envelope (a : Sender) (ReplyTo := a) (c : Receiver). Inductive beta (A : (fun x : Type => x) Type) := Redex (a : (fun x : Type => x) A). Inductive iota := Why n (a : match n in peano return Type with Zero => peano | Succ _ => unit end). Inductive large := K1 (_ : unit) | K2 (_ : unit) (_ : unit) | ... Inductive prim_int := PI (i : Int63.int). Inductive prim_float := PF (f : PrimFloat.float). Record fo_record := { f1 : peano; f2 : unit; }. Record pa_record A := { f3 : peano; f4 : A; }. Record pr_record A := { pf3 : peano; pf4 : A; }. (* with primitive projections *) Record dep_record := { f5 : peano; f6 : vect unit f5; }. Variant enum := E1 | E2 | E3. ``` test | eq | param1 | map | induction | isK | projK | bcongr | eqK | eqcorrect | eqOK | lens_laws -----------|---------|---------|---------|-----------|---------|---------|---------|---------|-----------|---------|---------- empty | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: unit | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: peano | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: option | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: pair | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: seq | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: rose | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: nest | :cloud: | :sunny: | :cloud: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :cloud: w | :cloud: | :sunny: | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :cloud: vect | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :bug: | :cloud: dyn | :cloud: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :bug: | :cloud: zeta | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: beta | :sunny: | :sunny: | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :sunny: | :cloud: iota | :cloud: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: | :bug: | :cloud: | :cloud: | :cloud: large | :sunny: | :sunny: | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: prim_int | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: prim_float | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: | :cloud: | :cloud: fo_record | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: pa_record | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: pr_record | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: dep_record | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :bug: | :cloud: enum | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: test | functor | inhab | congr | trivial | ----------|---------|---------|-----------|---------| is_empty | :sunny: | :sunny: | :sunny: | :sunny: | is_unit | :sunny: | :sunny: | :sunny: | :sunny: | is_peano | :sunny: | :sunny: | :sunny: | :sunny: | is_option | :sunny: | :sunny: | :sunny: | :sunny: | is_pair | :sunny: | :sunny: | :sunny: | :sunny: | is_seq | :sunny: | :sunny: | :sunny: | :sunny: | is_rose | :sunny: | :sunny: | :sunny: | :sunny: | is_nest | :bug: | :bug: | :cloud: | :cloud: | is_w | :bug: | :sunny: | :sunny: | :bug: | is_vect | :sunny: | :bug: | :cloud: | :bug: | is_dyn | :sunny: | :cloud: | :cloud: | :bug: | is_zeta | :sunny: | :sunny: | :sunny: | :sunny: | is_beta | :sunny: | :sunny: | :sunny: | :sunny: | is_iota | :sunny: | :bug: | :cloud: | :bug: | is_large | :sunny: | :sunny: | :bug: | :bug: | is_prim_int | :sunny: | :sunny: | :sunny: | :sunny: | is_is_prim_float| :sunny: | :sunny: | :sunny: | :sunny: | is_fo_record | :sunny: | :sunny: | :sunny: | :sunny: | is_pa_record | :sunny: | :sunny: | :sunny: | :sunny: | is_pr_record | :sunny: | :sunny: | :sunny: | :sunny: | is_dep_record| :sunny: | :bug: | :sunny: | :bug: | is_enum | :sunny: | :sunny: | :sunny: | :sunny: |

experimental (click to expand)

### `invert` ```coq Inductive is_list A PA : list A -> Type := | nilR : is_list (@nil A) | consR : forall a : A, PA a -> forall xs : list A, is_list xs -> is_list (cons a xs). Elpi derive.invert is_list. Print is_list_inv. (* Inductive is_list_inv (A : Type) (PA : A -> Type) (idx0 : list A) : Type := | nilR_inv : idx0 = nil -> is_list_inv A PA idx0 | consR_inv : forall a : A, PA a -> forall xs : list A, is_list_inv A PA xs -> idx0 = (cons a xs) -> is_list_inv A PA idx0. *) ``` ## `idx2inv` ```coq Elpi derive.idx2inv is_list. Check is_list_to_is_list_inv : forall A PA l, is_list A PA l -> is_list_inv A PA l. ```

## Writing a new derivation A derivation is made of: - a file implementing the derivation - a data base to carry some state - a stand alone command - a hook in the main derive procedure At the light of that, here a typical derivation file `myder.v`. The first section loads the standard derive code and declares the dependency the external file `myder.elpi`. The file `derive_hook.elpi` contains a few data types needed in order to register the derivation in the main derive loop. ```coq From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From mypkg Extra Dependency "myder.elpi" as myder. From elpi Require Import elpi. From elpi.apps Require Import derive. ``` The database is typically a predicate `myder` linking a type name to some concept previously derived. We also need to know if we did already derive a type, hence we declare a second predicate `myder-done` (we could reuse the former, but sometimes this is not easy, so here we are pedantic). We like to prefix these data bases name with `derive.`. ```coq Elpi Db derive.mydb.db lp:{{ % [myder T D] links a type T to a derived concept D pred myder o:gref, o:gref. % [myder-done T] mean T was already derived pred myder-done o:gref. }}. ``` Then we build a standalone derivation accessible via the name `derive.myder` which accumulates the external files declared before, the data base and an entry point ```coq Elpi Command derive.myder. Elpi Accumulate File derive_hook. Elpi Accumulate File myder. Elpi Accumulate Db derive.mydb.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.myder.main GR Prefix _. main _ :- usage. pred usage. usage :- coq.error "Usage: derive.myder ". }}. Elpi Typecheck. ``` This is enough to run the derivation via something like `Elpi derive.myder nat.`. In order to have `derive` run it one has to accumulate some code on top of `derive` itself. ```coq Elpi Accumulate derive Db derive.myder.db. Elpi Accumulate derive File myder. Elpi Accumulate derive lp:{{ dep1 "myder" "somedep". dep1 "myder" "someotherdep". derivation (indt T) Prefix % inputs (derive "myder" % name (for dep1) (derive.myder.main (indt T) Prefix) % code to run (myder-done (indt T)) % idempotency test ). }}. ``` First, one declares via `dep1` the derivations that should run before, here `somedep` and `someotherdep`. `derive` will compute a topological order and ensure dependencies are run first. Then one declares a derivation for a gref and a prefix. One can restrict which grefs can be derived, here for example we make `myder` only available on `indt` (inductive types, and not definitions or constructors). `Prefix` is a string, typically passed to the main code. The the `(derive ...)` tuple carrier the name of the derivation, already used in `dep1` and two predicates, one to run the derivation and one to test if the derivation was already run. The types for `dep1`, `derivation` and `derive` are declared in `derive_hook.elpi`. Finally, one is expected to `Import` the `myder.v` file in a derivation group, for example `better_std.v` would look like so: ```coq From elpi.apps Require Export derive. From elpi.apps Require Export derive.map derive.lens derive.lens_laws ... myder (* new derivation *) . Elpi Typecheck derive. ``` So when the user `Import`s `better_std` he gets a fully loaded `derive`. The code of the derivation must be put in a namespace. So `myder.elpi` should look like so ```elpi namespace derive.myder { pred main i:gref, i:string, o:list prop. main GR Prefix Clauses :- std.do! [ ... % synthesize Body and Type Name is Prefix ^ "myconcept", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName Body Type _ C, Clauses = [myder-done GR, myder GR (const C)], std.forall Clauses (x\ coq.elpi.accumulate _ "derive.myder.db" (clause _ _ x) ), ]. } ``` It is important that all clauses added to the database are also returned (see the last argument of `main`). Derive runs all derivations at once and databases are updated only when the program ends. So derive will assume, with `=>`, the clauses generated by one derivation before running the nest one. coq-elpi-1.19.3/apps/derive/_CoqProject000066400000000000000000000017471451177652200177150ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps -R theories elpi.apps -Q elpi elpi.apps.derive -R tests elpi.apps.derive.tests -R examples elpi.apps.derive.examples theories/derive.v theories/derive/std.v theories/derive/legacy.v theories/derive/experimental.v theories/derive/bcongr.v theories/derive/cast.v theories/derive/eq.v theories/derive/eqcorrect.v theories/derive/eqK.v theories/derive/eqOK.v theories/derive/map.v theories/derive/isK.v theories/derive/idx2inv.v theories/derive/invert.v theories/derive/projK.v theories/derive/param1.v theories/derive/param1_functor.v theories/derive/param1_congr.v theories/derive/param1_trivial.v theories/derive/param2.v theories/derive/induction.v theories/derive/lens.v theories/derive/lens_laws.v theories/derive/eqb_core_defs.v theories/derive/tag.v theories/derive/fields.v theories/derive/eqb.v theories/derive/eqbcorrect.v theories/derive/eqbOK.v theories/derive/eqType_ast.v coq-elpi-1.19.3/apps/derive/_CoqProject.test000066400000000000000000000013751451177652200206700ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -R theories elpi.apps -R tests elpi.apps.derive.tests -R examples elpi.apps.derive.examples tests/test_derive_stdlib.v tests/test_bcongr.v tests/test_derive.v tests/test_eq.v tests/test_eqK.v tests/test_eqOK.v tests/test_map.v tests/test_isK.v tests/test_projK.v tests/test_param1.v tests/test_param1_functor.v tests/test_param1_congr.v tests/test_param1_trivial.v tests/test_param2.v tests/test_induction.v tests/test_invert.v tests/test_idx2inv.v tests/test_eqcorrect.v tests/test_lens.v tests/test_lens_laws.v tests/test_tag.v tests/test_fields.v tests/test_eqb.v tests/test_eqbcorrect.v tests/test_eqbOK.v tests/test_eqType_ast.v examples/usage.v examples/readme.vcoq-elpi-1.19.3/apps/derive/derive.svg000066400000000000000000001620751451177652200175630ustar00rootroot00000000000000 image/svg+xml eqOK induction eqK eq param1 projK bcongr injection isK discriminate eqcorrect param1functor param1congr param1inhab param1trivial coq-elpi-1.19.3/apps/derive/elpi/000077500000000000000000000000001451177652200165025ustar00rootroot00000000000000coq-elpi-1.19.3/apps/derive/elpi/bcongr.elpi000066400000000000000000000114021451177652200206250ustar00rootroot00000000000000 /* Boolean congruence lemmas */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{nth, map2, assert!, rev, do!}. namespace derive.bcongr { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % take in input all hyps % links an assumption to the two terms being compared and the boolean value % for them: forall x y b (H : reflext (x = y) b), ----> (arg H x y b) type arg term -> term -> term -> term -> arg. pred bo-args i:term, i:term, i:term, i:list arg, o:term. bo-args (prod N S T) K1 K2 Hs (fun `x` S x\ fun `y` S y\ fun `b` {{bool}} b\ R x y b) :- !, @pi-decl `x` S x\ @pi-decl `y` S y\ @pi-decl `b` {{ Coq.Init.Datatypes.bool }} b\ @pi-decl Hn (TH x y b) h\ do! [ TH x y b = {{ lib:elpi.reflect (lib:@elpi.eq lp:S lp:x lp:y) lp:b }}, R x y b = (fun `h` (TH x y b) h\ Body x y b h), coq.name-suffix `h` N Hn, bo-args (T x) {coq.mk-app K1 [x]} {coq.mk-app K2 [y]} [arg h x y b|Hs] (Body x y b h) ]. bo-args T K1 K2 HsRev Bo :- (T = global (indt _) ; T = app[global (indt _)|_]), !, rev HsRev Hs, mk-conj Hs Conj, Concl = {{ lib:elpi.reflect (lib:@elpi.eq lp:T lp:K1 lp:K2) lp:Conj }}, elim-all 0 Hs Concl Bo. bo-args T K1 K2 HsRev Bo :- whd1 T T1, !, bo-args T1 K1 K2 HsRev Bo. pred mk-conj i:list arg, o:term. mk-conj [] {{ lib:elpi.true }}. mk-conj [arg _ _ _ X] X :- !. mk-conj [arg _ _ _ X|XS] {{ lib:elpi.andb lp:X lp:C }} :- mk-conj XS C. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % we case split on each and every assumption (arg H _ _ _) pred elim-all i:int, i:list arg, o:term, o:term. elim-all _ [] {{ lib:elpi.reflect lp:P lp:_}} {{ lib:elpi.ReflectT lp:P (lib:@elpi.erefl lp:T lp:LHS) }} :- coq.safe-dest-app P _ [T,LHS,_]. elim-all N [arg H X Y B|Hs] P R :- decl H _ TH, (pi x b\ copy Y x => copy B b => copy P (Pxb x b)), !, coq.build-match H TH (otyR Pxb Y) (branchR Pxb X Y N Hs) R. pred otyR i:(term -> term -> term), i:term, i:term, i:list term, i:list term, o:term. otyR F X _ [Idx,_] _ R :- R = F X Idx. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Two branch per hyp: ReflectT or ReflectF % we continue pred branchR i:(term -> term -> term), i:term, i:term, i:int, i:list arg, i:term ,i:term, i:list term, i:list term, o:term. branchR Pxb X _ N Hs K _ [E] [ET] R :- coq.safe-dest-app K {{ lib:elpi.ReflectT }} _, !, coq.build-match E ET (otyE Pxb {{ lib:elpi.true}}) (branchE (Pxb X {{ lib:elpi.true }}) N Hs) R. % we stop, emit ReflectF and prove false via injection branchR Pxb _ Y N _ K _ [NE] [_] R :- coq.safe-dest-app K {{ lib:elpi.ReflectF }} _, !, Pxb Y {{ lib:elpi.false}} = {{ lib:elpi.reflect lp:P lp:_ }}, R = {{ lib:elpi.ReflectF lp:P lp:PNE }}, PNE = (fun `h` P h\ app[NE, Inj h]), @pi-decl `h` P h\ do! [ ltac.injection h P _ (PEs h), nth N (PEs h) (Inj h) ]. pred branchE i:term, i:int, i:list arg, i:term ,i:term, i:list term, i:list term, o:term. branchE P N Hs _ _ [] [] R :- M is N + 1, elim-all M Hs P R. pred otyE i:(term -> term -> term), i:term, i:term, i:list term, i:list term, o:term. otyE F B _ [X,_] _ R :- R = F X B. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % we take in input all parameters pred bo-param i:int, i:term, i:term, o:term. bo-param 0 K T R :- !, bo-args T K K [] R. bo-param N K (prod Name Src T) (fun Name Src T1) :- N > 0, !, M is N - 1, @pi-decl Name Src x\ bo-param M {coq.mk-app K [x]} (T x) (T1 x). bo-param N K T R :- whd1 T T1, !, bo-param N K T1 R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for each constructor we generate the congruence lemma pred main-constructor i:int, i:string, i:constructor, i:term, o:prop. main-constructor Lno Prefix K Kt Clause :- do! [ Kn = global (indc K), % we build the comparison function bo-param Lno Kn Kt R, std.assert-ok! (coq.typecheck R RT) "derive.bcongr generates illtyped term", Name is Prefix ^ "bcongr_" ^ {coq.gref->id (indc K)}, coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R RT @opaque! Cong, % we register it as a clause Clause = (bcongr-db K (global (const Cong)) :- !), coq.elpi.accumulate _ "derive.bcongr.db" (clause _ (before "bcongr-db:fail") Clause) ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred main i:inductive, i:string, o:list prop. main GR Prefix Clauses :- do! [ coq.env.indt GR Ind Lno _ _ Kns Ktys, assert! (Ind = tt) "derive.bcongr: Coinductive types are not supported", map2 Kns Ktys (main-constructor Lno Prefix) Clauses ]. } % vim: set spelllang=: coq-elpi-1.19.3/apps/derive/elpi/cast.elpi000066400000000000000000000035701451177652200203140ustar00rootroot00000000000000/* Type cast using an equation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{append, rev, any->string, last, take}. namespace derive.cast { namespace aux { arity [] _ (sort (typ U)) :- coq.univ.new U. arity [V|VS] Acc (prod `x` T R) :- coq.mk-app V {rev Acc} T, pi x\ arity VS [x|Acc] (R x). args [] [X|_] X. args [V|VS] Acc (fun `c` S R) :- coq.mk-app V {rev Acc} S, pi c\ args VS [c|Acc] (R c). arg _ _ _ _ _ [] _ []. arg I E X Y Ps [V|VS] Acc [R|RS] :- cast-db I T, take {calc (I )} Ps PsI, coq.mk-app T {append {append PsI [X,Y,E]} {append {rev Acc} [V]}} R, J is I + 1, arg J E X Y Ps VS [V|Acc] RS. args-ty E X Y Ps [] [_|Acc] R :- last Ps V, rev Acc [_|Vars], arg 2 E X Y Ps Vars [] CastedVars, coq.mk-app V [X|CastedVars] R. args-ty E X Y Ps [V|VS] Acc (prod `c` S R) :- coq.mk-app V {rev Acc} S, pi c\ args-ty E X Y Ps VS [c|Acc] (R c). body I J V (fun Name T R) :- I > 0, !, coq.name-suffix `A` {calc (J - I)} Name, I1 is I - 1, arity {rev V} [] T, pi x\ body I1 J [x|V] (R x). body 0 _ V R :- rev V [A|Rest], Ety = (x\y\ {{ @eq lp:A lp:x lp:y }}), R = {{ fun (x y : lp:A) (e : lp:(Ety x y)) => lp:(Bo x y e) }}, pi x y e\ coq.build-match e (Ety x y) (rty A Rest x) (body-branch Rest x) (Bo x y e). rty A Rest X _ [Y,E] _ R :- args-ty E X Y [A|Rest] Rest [Y] R. body-branch Rest Y _ _ _ _ R :- args Rest [Y] R. } pred main i:int. main N :- Name is "cast" ^ {any->string N}, aux.body N N [] Bo, std.assert-ok! (coq.typecheck Bo Ty) "derive.cast generates illtyped term", coq.env.add-const Name Bo Ty _ C, coq.elpi.accumulate _ "derive.cast.db" (clause _ _ (cast-db N (global (const C)))). } coq-elpi-1.19.3/apps/derive/elpi/derive.elpi000066400000000000000000000125141451177652200206360ustar00rootroot00000000000000/* Entry point for all derivations */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive { pred exists-indc i:inductive, i:(constructor -> prop). exists-indc I P :- coq.env.indt I _ _ _ _ KL _, std.exists KL P. pred if-verbose i:prop. if-verbose P :- (get-option "verbose" tt ; get-option "recursive" tt), !, P. if-verbose _. pred dep o:string, o:string. dep X Y :- dep1 X Y. dep X Y :- dep1 X Z, dep Z Y. pred selected i:string. selected Name :- get-option "only" Map, !, Map => (get-option Name _; (get-option X _, dep X Name)). selected _. pred validate-only i:gref, i:list derive. validate-only T LD :- get-option "only" Map, !, std.forall Map (known-option T LD). validate-only _ _. pred known-option i:gref, i:list derive, i:prop. known-option T L (get-option X _) :- if (std.mem! L (derive X _ _)) true (coq.error "Derivation" X "unknown or not applicable to input" T). pred chain i:gref, i:list derive, o:list prop. chain _ [] []. chain T [derive Name _ _|FS] CL :- not(selected Name), !, if-verbose (coq.say "Skipping derivation" Name "on" T "since the user did not select it"), chain T FS CL. chain T [derive Name _ AlreadyDone|FS] CL :- (pi x\ stop x :- !, fail) => AlreadyDone, !, if-verbose (coq.say "Skipping derivation" Name "on" T "since it has been already run"), chain T FS CL. chain T [derive Name F _|FS] CL :- get-option "only" _, !, % request this one if-verbose (coq.say "Derivation" Name "on" T), @dropunivs! => std.time (F C) Time, if-verbose (coq.say "Derivation" Name "on" T "took" Time), C => chain T FS CS, std.append C CS CL. chain T [derive Name F _|FS] CL :- % all are selected, we can fail if-verbose (coq.say "Derivation" Name "on" T), (pi x\ stop x :- !, fail) => @dropunivs! => std.time (F C) Time, !, if-verbose (coq.say "Derivation" Name "on" T "took" Time), C => chain T FS CS, std.append C CS CL. chain T [derive F _ _|FS] CL :- if-verbose (coq.say "Derivation" F "on" T "failed, continuing"), chain T FS CL. pred toposort i:list derive, o:list derive. toposort L SL :- std.findall (dep1 _ _) Deps, topo L Deps SL. pred std.partition i:list A, i:(A -> prop), o:list A, o:list A. std.partition [] _ [] []. std.partition [X|XS] P [X|R] L :- P X, !, std.partition XS P R L. std.partition [X|XS] P R [X|L] :- std.partition XS P R L. pred not-a-src i:list prop, i:derive. not-a-src Deps (derive A _ _) :- not(std.mem! Deps (dep1 A _)). pred tgt-is-not-in i:list derive, i:prop. tgt-is-not-in [] _. tgt-is-not-in [derive Tgt _ _|_] (dep1 _ Tgt) :- !, fail. tgt-is-not-in [_|L] D :- tgt-is-not-in L D. pred topo i:list derive, i:list prop, o:list derive. topo [] _ [] :- !. topo L Deps SL :- std.partition L (not-a-src Deps) LNoDeps Other, if (LNoDeps = []) (coq.error "derive: no topological order:" L Deps) true, std.filter Deps (tgt-is-not-in LNoDeps) NewDeps, topo Other NewDeps SOther, std.append LNoDeps SOther SL. pred export? i:prop, o:prop. export? (export M) (coq.env.export-module M). pred indt-or-const i:gref. indt-or-const (indt _). indt-or-const (const _). pred main i:gref, i:bool, o:list prop. main T P CL :- get-option "recursive" tt, !, coq.env.dependencies T _ AllDeps, coq.gref.set.elements AllDeps AllDepsL, std.filter AllDepsL indt-or-const Deps, main.aux Deps [] CL1, CL1 => main1 T P CL2, std.append CL1 CL2 CL. pred main.aux i:list gref, i:list prop, o:list prop. main.aux [] X X. main.aux [T|TS] Acc CL :- (pi X\get-option "only" X :- !, fail) => Acc => main T tt CL1, main.aux TS {std.append CL1 Acc} CL. main T P CL :- main1 T P CL. pred main1 i:gref, i:bool, o:list prop. main1 T P CL :- if (P = tt) (Prefix is {coq.gref->id T} ^ "_") (Prefix = ""), std.findall (derivation T Prefix _) L, if (L = []) (coq.error "no derivation found, did you Import derive.std?") true, std.map L (x\r\ x = derivation _ _ r) DL, validate-only T DL, toposort DL SortedDL, chain T SortedDL CL. pred decl+main i:indt-decl. decl+main DS :- std.do! [ indt-decl-name DS ModName, if-verbose (coq.say "Starting module" ModName), coq.env.begin-module ModName none, std.assert-ok! (coq.elaborate-indt-decl-skeleton DS D) "Inductive type declaration illtyped", if-verbose (coq.say "Declaring inductive" D), coq.env.add-indt D I, if-verbose (coq.say "Deriving"), main (indt I) ff CL, if-verbose (coq.say "Done"), coq.env.end-module _, coq.env.indt I _ _ _ _ KS _, std.map KS (k\r\ r = indc k) KGRS, std.map KGRS coq.gref->id KNS, std.map KGRS (gr\r\ r = global gr) KTS, std.forall2 [ModName|KNS] [global (indt I)|KTS] short-alias, coq.indt-decl->implicits DS IndImpls KsImpls, if (coq.any-implicit? IndImpls) (@global! => coq.arguments.set-implicit (indt I) [IndImpls]) true, std.forall2 KsImpls KS (i\k\ if (coq.any-implicit? i) (@global! => coq.arguments.set-implicit (indc k) [i]) true ), std.map-filter CL export? P, std.do! P, ]. pred short-alias i:id, i:term. short-alias ID T :- @global! => coq.notation.add-abbreviation ID 0 T ff _. pred indt-decl-name i:indt-decl, o:string. indt-decl-name (parameter _ _ _ Decl) Name :- pi x\ indt-decl-name (Decl x) Name. indt-decl-name (inductive Name _ _ _) Name. indt-decl-name (record Name _ _ _) Name. } coq-elpi-1.19.3/apps/derive/elpi/derive_hook.elpi000066400000000000000000000006411451177652200216540ustar00rootroot00000000000000/* Entry point for derive extensions */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ pred derivation i:gref, i:string, o:derive. pred export i:modpath. pred dep1 o:string, o:string. kind derive type. type derive string -> (list prop -> prop) -> prop -> derive. coq-elpi-1.19.3/apps/derive/elpi/discriminate.elpi000066400000000000000000000024461451177652200220360ustar00rootroot00000000000000/* core of discriminate */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{ do! }. namespace ltac { % Tests if the command can be applied pred discriminate? i:term, i:inductive, o:list term, o:constructor, o:term, o:term. discriminate? Ty GR Args GRA A B :- do! [ whd Ty [] {{lib:@elpi.eq}} [T,A,B], whd T [] (global (indt GR)) Args, whd A [] (global (indc GRA)) _, whd B [] (global (indc GRB)) _, not(GRA = GRB) ]. % Does the job pred discriminate! i:term, i:term, o:term, i:inductive, i:list term, i:constructor, i:term, i:term. discriminate! H G PG GR Args GRA A B :- do! [ isK-db GRA IsKA, coq.mk-app IsKA Args IsKAArgs, Eq_isKA_isKB = app[{{lib:elpi.derive.eq_f}},app[global (indt GR)|Args],{{lib:elpi.bool}},IsKAArgs,A,B,H], PG = app[{{lib:elpi.bool_discr}},Eq_isKA_isKB,G] ]. pred discriminate i:term, i:term, i:term, o:term. discriminate H EqAB G PG :- if (discriminate? EqAB GR Args GRA A B) (discriminate! H G PG GR Args GRA A B) (coq.error "discriminate: the equation" {coq.term->string H} "of type" {coq.term->string EqAB} "is trivial at the top level"). } % vim:set ft=lprolog spelllang=: coq-elpi-1.19.3/apps/derive/elpi/eq.elpi000066400000000000000000000155061451177652200177710ustar00rootroot00000000000000/* Boolean comparison functions */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, append}. namespace derive.eq { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Fills in the matrix with the truth values pred body i:term, i:list term, i:list term, % constructor, arguments and their types i:term, i:list term, i:list term, % constructor, arguments and their types o:term. %result :name "derive.eq.body:begin" % Extension point (e.g. to skip a subterm) body K [] _ K [] _ R :- !, % no arguments, same constructor R = {{ true }}. body K [X] [T1] K [Y] [T2] R :- !, % special case to avoid ".. && true" eq-db T1 T2 F, coq.mk-app F [X,Y] R. body K [X|XS] [T1|TS1] K [Y|YS] [T2|TS2] R :- !, % compare X with Y eq-db T1 T2 F, coq.mk-app F [X,Y] RX, % compare XS with YS body K XS TS1 K YS TS2 RXS, R = {{ (lp:RX && lp:RXS)%bool }}. body _ _ _ _ _ _ R :- !, % outside the diagonal it is always false R = {{ false }}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Build the body pred bo-idx i:prop, % eq-db clause for the current type (applied to params) i:term, % inductive type (applied to params) for the first argument i:term, % arity left for the first argument i:term, % inductive type (applied to params) for the second argument i:term, % arity left for the second argument i:int, % accumulator to set Recno o:int, % Recno o:term, % Type of the term being built o:term. % Term buing built bo-idx C Ity1 (prod _ Src1 Tgt1) Ity2 (prod _ Src2 Tgt2) N M Rty R :- !, coq.name-suffix `i` 1 I1, coq.name-suffix `i` 2 I2, R = (fun I1 Src1 i\ fun I2 Src2 j\ Rrec i j), Rty = (prod I1 Src1 i\ prod I2 Src2 j\ Rtyrec i j), quantify-eq-db-idx C Crec, pi x y\ decl x `i` Src1 => decl y `j` Src2 => bo-idx Crec {coq.mk-app Ity1 [x]} (Tgt1 x) {coq.mk-app Ity2 [y]} (Tgt2 y) {calc (N + 2)} M (Rtyrec x y) (Rrec x y). bo-idx C Ity1 (sort _) Ity2 (sort _) N N Rty R :- !, Rty = {{ lp:Ity1 -> lp:Ity2 -> bool }}, R = {{ fun (x1 : lp:Ity1) (x2 : lp:Ity2) => lp:(Bo x1 x2) }}, pi x1 x2\ decl x1 `a` Ity1 => decl x2 `b` Ity2 => C => bo-matrix x1 Ity1 x2 Ity2 (Bo x1 x2). bo-idx C Ity1 X Ity2 Y N M Rty R :- whd1 X X1, whd1 Y Y1, !, bo-idx C Ity1 X1 Ity2 Y1 N M Rty R. pred bo-matrix i:term, i:term, i:term, i:term, o:term. bo-matrix X1 TyX1 X2 TyX2 R :- coq.build-match X1 TyX1 bo-ty (k1\ _\ a1\ ty1\ coq.build-match X2 TyX2 bo-ty (k2\ _\ a2\ ty2\ body k1 a1 ty1 k2 a2 ty2)) R. pred bo-ty i:term, i:list term, i:list term, o:term. bo-ty _ _ _ {{ bool }}. % Take in input all parameters and their comparison function %%%%%%%%%%%%%% pred bo-param i:int, % Number of parameters, recursion fuel i:term, % Inductive type (applied to all parameters taken in input) i:term, % Inductive type arity (parameters + indexes) o:term. % Comparison function bo-param 0 Ity Arity R :- coq.safe-dest-app Ity (global (indt GR)) _, coq.env.recursive? GR, !, Boidx = fix `f` Recno Rty Rbo, (pi f\ decl f `f` Rty => % We build the body (assuming the indexes are *not* the same) bo-idx (eq-db Ity Ity f :- []) Ity Arity Ity Arity 0 Recno Rty (Rbo f)), % We then pass to the body the terms with their indexes (that are the same) apply-idx Ity Arity Boidx R. bo-param 0 Ity Arity R :- !, bo-idx (pi f\eq-db Ity Ity f :- fail) Ity Arity Ity Arity 0 _ _ Boidx, apply-idx Ity Arity Boidx R. bo-param N Ity (prod _ Sty Rty) R :- !, M is N - 1, R = {{ fun (A : lp:Sty) (eqA : A -> A -> bool) => lp:(Bo A eqA) }}, pi a f\ sigma ItyA\ coq.mk-app Ity [a] ItyA, eq-db a a f => decl a `a` Sty => decl f `f` {{ lp:a -> lp:a -> bool }} => bo-param M ItyA (Rty a) (Bo a f). bo-param N Ity X R :- whd1 X X1, !, bo-param N Ity X1 R. pred apply-idx i:term, % Ity applied to parameters i:term, % Arity remaining after parameters i:term, % Bo comparison with potentially different indexes as per bo-idx o:term. % fun idx1 idx2 (x1 : Ity ixd1) (x2 : Ity idx2) => Bo idx1 x1 idx2 x2 apply-idx _ (sort _) Bo Bo :- !. % no indexes -> avoid eta expansion of Bo apply-idx Ity Arity Bo R :- apply-idx.aux Ity Arity Bo R. apply-idx.aux Ity (prod N S T) Bo (fun N S x\ R x) :- !, pi x\ apply-idx.aux {coq.mk-app Ity [x]} (T x) {coq.mk-app Bo [x,x]} (R x). apply-idx.aux Ity (sort _) Bo (fun `x1` Ity x1\ fun `x2` Ity x2\ Bo1 x1 x2) :- !, pi x1 x2\ coq.mk-app Bo [x1,x2] (Bo1 x1 x2). apply-idx.aux Ity X Bo R :- whd1 X X1, !, apply-idx.aux Ity X1 Bo R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Builds a clause for eq-db that fits the inductive arity: % - a premise per type parameter % - a simple argument for each index % Also used to load the context under the fix pred quantify-eq-db-idx i:prop, o:prop. quantify-eq-db-idx (pi x y\ C x y) (pi x y\ C1 x y) :- pi x y\ quantify-eq-db-idx (C x y) (C1 x y). quantify-eq-db-idx (eq-db A B C :- L) (pi x y\ eq-db (A1 x) (B1 y) (C1 x y) :- L) :- pi x y\ coq.mk-app A [x] (A1 x), coq.mk-app B [y] (B1 y), coq.mk-app C [x,y] (C1 x y). pred quantify-eq-db-param i:prop, o:prop. quantify-eq-db-param (pi x f\ C x f) (pi x f\ C1 x f) :- pi x f\ quantify-eq-db-param (C x f) (C1 x f). quantify-eq-db-param (eq-db A B C :- L) (pi x f\ eq-db (A1 x) (B1 x) (C1 x f) :- L1 x f) :- pi x f\ append [eq-db x x f] L (L1 x f), coq.mk-app A [x] (A1 x), coq.mk-app B [x] (B1 x), coq.mk-app C [x,f] (C1 x f). pred mk-clause i:int, i:term, i:prop, o:prop. mk-clause Lno (prod _ _ Tx) C R :- Lno > 0, !, Lno1 is Lno - 1, quantify-eq-db-param C C1, pi x\ mk-clause Lno1 (Tx x) C1 R. mk-clause 0 (prod _ _ Tx) C R :- !, quantify-eq-db-idx C C1, pi x\ mk-clause 0 (Tx x) C1 R. mk-clause 0 (sort _) C C :- !. mk-clause N T A B :- whd1 T T1, !, mk-clause N T1 A B. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred main i:inductive, i:string, o:list prop. main GR Name [Clause1, Clause2] :- do! [ coq.env.indt GR Ind Lno Luno Arity _ _, assert! (Ind = tt) "derive.eq: Coinductive types are not supported", assert! (Lno = Luno) "derive.eq: Non-uniform parameters not supported", % we build the comparison function bo-param Lno (global (indt GR)) Arity RSkel, std.assert-ok! (coq.elaborate-skeleton RSkel RT R) "derive.eq generates illtyped term", coq.env.add-const Name R RT _ Cmp, % we register it as a clause mk-clause Lno Arity (eq-db (global (indt GR)) (global (indt GR)) (global (const Cmp)) :- [!]) Clause1, coq.elpi.accumulate _ "derive.eq.db" (clause _ (before "eq-db:fail") Clause1), Clause2 = eq-for GR Cmp, coq.elpi.accumulate _ "derive.eq.db" (clause _ _ Clause2), ]. } % vim: set spelllang=: coq-elpi-1.19.3/apps/derive/elpi/eqK.elpi000066400000000000000000000075061451177652200201050ustar00rootroot00000000000000/* eq.axiom for each constructor */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, last, map2}. namespace derive.eqK { % links a term x, a comparison cmp, and H : eq_axiom cmp x pred axiom-db i:term, o:term, o:term. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % case split on the second constructor % same constructor, we use the bcongr lemma pred branch i:term, i:term, i:term, i:list term, i:list term, i:term. branch K1 K2 _ V _ R :- coq.safe-dest-app K1 (global (indc GR)) Args1, coq.safe-dest-app K2 (global (indc GR)) LArgs2, !, do! [ bcongr-db GR Lem, call Lem Args1 LArgs2 V R, ]. % different constructor, ReflectF + discriminate branch K1 K2 T V _ R :- coq.safe-dest-app K2 _ _, !, do! [ coq.mk-app K2 V K2A, Eq = {{ lib:@elpi.eq lp:T lp:K1 lp:K2A }}, R = {{ lib:@elpi.ReflectF lp:Eq (fun abs : lp:Eq => lp:(Bo abs)) }}, (pi abs\ ltac.discriminate abs Eq {{ lib:elpi.False }} (Bo abs)), ]. pred call i:term, i:list term, i:list term, i:list term, o:term. call X [] [] [] X. call X [P|P1] [_|Q1] V R :- coq.mk-app X [P] XP, call XP P1 Q1 V R. call X [A|AS] [] [B|BS] R :- if (axiom-db A F P) true (M is "derive.eqK: no proved comparison for " ^ {coq.term->string A}, stop M), coq.mk-app X [A,B,{coq.mk-app F [A,B]},{coq.mk-app P [B]}] XAB, call XAB AS [] BS R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % bind the arguments of the constructor pred args i:term, i:term, o:term. args (prod _ S T) K R :- !, std.assert! (eq-db S S F) "derive.eqK: cannot find an eq test for constructor argument", R = (fun `x` S x\ fun `h` {{ lib:elpi.derive.eq_axiom_at lp:S lp:F lp:x }} (Bo x)), @pi-decl `x` S x\ @pi-decl `h` {{ lib:elpi.derive.eq_axiom_at lp:S lp:F lp:x }} h\ axiom-db x F h => args (T x) {coq.mk-app K [x]} (Bo x h). args T K (fun `x` T R) :- (T = global (indt _) ; T = app[global (indt _)|_]), !, eq-db T T Cmp, @pi-decl `x` T x\ coq.build-match x T (oty Cmp K) (branch K) (R x). args T K R :- whd1 T T1, !, args T1 K R. args T _ _ :- M is "derive.eqK: cannot find an eq test for " ^ {coq.term->string T}, stop M. pred oty i:term, i:term, i:term, i:list term, i:list term, o:term. oty Cmp K _ V VT R :- last V X, last VT T, R = {{ lib:elpi.derive.eq_axiom_on lp:T lp:Cmp lp:K lp:X }}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % For each parameter take in input a comparison function pred param i:int, i:term, i:term, o:term. param 0 T K R :- args T K R. param L (prod N S T) K R :- L > 0, !, R = (fun N S a\ fun `f` {{ lp:a -> lp:a -> bool }} (Bo a)), M is L - 1, @pi-decl N S a\ @pi-decl `f` {{ lp:a -> lp:a -> bool }} f\ eq-db a a f => param M (T a) {coq.mk-app K [a]} (Bo a f). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for each constructor we generate the case split lemma pred main-constructor i:int, i:string, i:constructor, i:term, o:prop. main-constructor Lno Prefix K Kty C :- do! [ assert! (bcongr-db K _) "derive.eqK: run derive.bcongr first", % generate the K-split lemma param Lno Kty (global (indc K)) RSkel, % add to the environment std.assert-ok! (coq.elaborate-skeleton RSkel RT R) "derive.eqK generates illtyped term", coq.gref->id (indc K) Kname, Name is Prefix ^ Kname, coq.env.add-const Name R RT @opaque! EqK, % add the clause to the db C = (eqK-db K (global (const EqK)) :- !), coq.elpi.accumulate _ "derive.eqK.db" (clause _ (before "eqK-db:fail") C) ]. pred main i:inductive, i:string, o:list prop. main GR Prefix Clauses :- coq.env.indt GR _ Lno _ _ Kns Ktys, map2 Kns Ktys (main-constructor Lno Prefix) Clauses. } coq-elpi-1.19.3/apps/derive/elpi/eqOK.elpi000066400000000000000000000030671451177652200202220ustar00rootroot00000000000000/* constant elimination */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!}. namespace derive.eqOK { pred body i:int, i:term, i:term, i:term, o:term. body N (prod NA A a\ prod NF (A_eq a) (B a)) E TisT (fun NA A a\ fun NF (A_eq a) f\ fun `p` (PA a f) (B1 a f)) :- N > 0, !, M is N - 1, @pi-decl NA A a\ @pi-decl NF (A_eq a) f\ (PA a f = {{ lib:elpi.derive.eq_axiom lp:a lp:f }}, @pi-decl `p` (PA a f) p\ body M (B a f) {coq.mk-app E [a,f]} {coq.mk-app TisT [a, {{lib:elpi.derive.eq_axiom_at lp:a lp:f}}, p]} (B1 a f p)). % done body 0 (prod N S x\ prod _ _ _) E TisT (fun N S R) :- @pi-decl N S x\ R x = {{ lp:E lp:x (lp:TisT lp:x) }}. pred main i:inductive, i:string, o:list prop. main GR O [eqOK-done GR] :- do! [ T = global (indt GR), coq.env.indt GR _ Lno _ _ _ _, assert! (eqcorrect-db (indt GR) E) "derive.eqOK: use derive.eqcorrect before", coq.env.typeof {coq.term->gref E} ETy, assert! (reali T IsT) "derive.eqOK: use derive.param1 before", assert! (param1-inhab-db IsT TisT) "derive.eqOK: use derive.param1.inhab before", body Lno ETy E TisT NewBo, %coq.say {coq.term->string NewBo}, std.assert-ok! (coq.typecheck NewBo NewTy) "derive.eqOK generates illtyped term", coq.env.add-const O NewBo NewTy @opaque! _, coq.elpi.accumulate _ "derive.eqOK.db" (clause _ _ (eqOK-done GR)), ]. } coq-elpi-1.19.3/apps/derive/elpi/eqType.elpi000066400000000000000000000150211451177652200206230ustar00rootroot00000000000000/* eqType representation and validation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive.eqType.ast { pred translate-indt i:inductive, o:eqType, o:diagnostic. translate-indt I O D :- coq.env.indt-decl I Decl, coq.env.indt I _ _ _ _ KN _, translate-param Decl I KN O D. pred translate-param i:indt-decl, i:inductive, i:list constructor, o:eqType, o:diagnostic. translate-param (parameter ID _ Ty F) I KS (type-param F1) D :- whd Ty [] {{ Type }} _, !, @pi-parameter ID Ty x\ pi y\ term->trm x y ok => translate-param (F x) I KS (F1 y) D. translate-param (parameter ID _ Ty F) I KS (value-param Ty1 F1) D :- term->trm Ty Ty1 ok, !, @pi-parameter ID Ty x\ pi y\ term->trm x y ok => translate-param (F x) I KS (F1 y) D. translate-param (parameter ID _ _ _) _ _ _ (error S) :- S is "unsupported parameter " ^ ID. translate-param (inductive ID tt (arity (sort S)) F) I KS (inductive I F1) D :- @pi-inductive ID (arity (sort S)) x\ pi y\ term->trm x y ok => translate-constructors (F x) KS (F1 y) D. translate-param (record _ _ _ F) I [K] (inductive I (y\ [constructor K (F1 y)])) D :- !, pi y\ self y => translate-record-constructor F (F1 y) D. translate-param _ _ _ _ (error S) :- S is "unsupported inductive arity". pred translate-constructors i:list indc-decl, i:list constructor, o:list constructor, o:diagnostic. translate-constructors [] [] [] ok. translate-constructors [constructor _ A|KS] [K|KK] [constructor K Args|KS1] D :- std.do-ok! D [ translate-arguments {coq.arity->term A} Args, translate-constructors KS KK KS1, ]. pred translate-arguments i:term, o:arguments, o:diagnostic. translate-arguments T T2 D :- whd1 T T1, !, translate-arguments T1 T2 D. translate-arguments (prod N Ty F) (irrelevant Ty1 F1) D :- not(pi x\ occurs x (F x)), irrelevant? Ty Ty1 ok, !, @pi-decl N Ty x\ translate-arguments (F x) F1 D. translate-arguments (prod N Ty F) (regular Ty1 F1) D :- not(pi x\ occurs x (F x)), !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-decl N Ty x\ translate-arguments (F x) F1 d), ]. translate-arguments (prod N Ty F) (dependent Ty1 F1) D :- !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-decl N Ty x\ pi y\ term->trm x y ok => translate-arguments (F x) (F1 y) d), ]. translate-arguments Ty (stop Ty1) D :- name Ty, term->trm Ty Ty1 D. translate-arguments (app [N|_] as Ty) (stop Ty1) D :- name N, term->trm Ty Ty1 D. translate-arguments T _ (error S) :- S is "unsupported argument " ^ {coq.term->string T}. pred translate-record-constructor i:record-decl, o:arguments, o:diagnostic. translate-record-constructor end-record (stop X) ok :- self X. translate-record-constructor (field _ ID Ty F) (irrelevant Ty1 F1) D :- not(pi x\ occurs x (F x)), irrelevant? Ty Ty1 ok, !, @pi-parameter ID Ty x\ translate-record-constructor (F x) F1 D. translate-record-constructor (field _ ID Ty F) (regular Ty1 F1) D :- not(pi x\ occurs x (F x)), !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-parameter ID Ty x\ translate-record-constructor (F x) F1 d), ]. translate-record-constructor (field _ ID Ty F) (dependent Ty1 F1) D :- !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-parameter ID Ty x\ pi y\ term->trm x y ok => translate-record-constructor (F x) (F1 y) d), ]. translate-record-constructor (field _ ID _ _) _ (error S) :- S is "unsupported record field " ^ ID. pred self o:trm. pred valid i:trm, o:diagnostic. valid {{ PrimInt63.int }} ok :- !. valid (global (indt I)) ok :- eqType I _, !. valid (app (indt I) A Args) D :- eqType I EQT, !, valid-eqType EQT [A|Args] D. valid T (error S) :- S is "not an eqType: " ^ {std.any->string T}. pred valid-eqType i:eqType, i:list trm, o:diagnostic. valid-eqType (inductive _ _) [] ok. valid-eqType (type-param F) [T|TS] D :- std.do-ok! D [ valid T, (d\ pi x\ valid-eqType (F x) TS d), ]. valid-eqType (value-param _ F) [_|TS] D :- std.do-ok! D [ (d\ pi x\ valid-eqType (F x) TS d), ]. pred irrelevant? i:term, o:trm, o:diagnostic. irrelevant? (app [{{ @eq }}, global (indt EqType), A, B]) (app EQ EQTYPE [A1,B1]) D :- std.do-ok! D [ std.lift-ok (eqType EqType _) "Not an eqType", %eqb-for Bool Bool _, std.lift-ok ({{ @eq }} = global EQ) "", term->trm (global (indt EqType)) EQTYPE, term->trm A A1, term->trm B B1, ]. irrelevant? T R D :- whd1 T T1, coq.say "whd" T T1, irrelevant? T1 R D. pred term->trm i:term, o:trm, o:diagnostic. term->trm (global GR) (global GR) ok :- !. term->trm (app [global GRF,A|As]) (app GRF A1 As1) D :- !, std.do-ok! D [ term->trm A A1, map-ok! As term->trm As1, ]. term->trm {{ lp:A -> lp:B }} (app {{:gref lib:elpi.derive.arrow }} A1 [B1]) D :- std.do-ok! D [ term->trm A A1, term->trm B B1, ]. term->trm (app [N|As]) (app {{:gref lib:elpi.derive.apply }} N1 As1) D :- name N, !, std.do-ok! D [ term->trm N N1, map-ok! As term->trm As1, ]. term->trm X _ (error S) :- S is "not an applicative term: " ^ {coq.term->string X}. pred map-ok! i:list A, i:(A -> B -> diagnostic -> prop), o:list B, o:diagnostic. map-ok! [] _ [] ok. map-ok! [X|XS] F [Y|YS] D :- F X Y D1, if (D1 = ok) (map-ok! XS F YS D) (D = D1). pred validate-eqType i:eqType, o:diagnostic. validate-eqType (type-param F) D :- pi x\ valid x ok => validate-eqType (F x) D. validate-eqType (value-param _ F) D :- pi x\ validate-eqType (F x) D. validate-eqType (inductive _ F) D :- pi x\ valid x ok => validate-constructors (F x) D. pred validate-constructors i:list constructor, o:diagnostic. validate-constructors [] ok. validate-constructors [constructor _ Args|Ks] D :- std.do-ok! D [ validate-arguments Args, validate-constructors Ks ]. pred validate-arguments i:arguments, o:diagnostic. validate-arguments (stop _) ok. validate-arguments (regular T Args) D :- std.do-ok! D [ valid T, validate-arguments Args, ]. validate-arguments (irrelevant _ Args) D :- validate-arguments Args D. validate-arguments (dependent T Args) D :- std.do-ok! D [ valid T, (d\ pi x\ validate-arguments (Args x) d), ]. pred main i:inductive, o:list prop. main I [C] :- std.assert-ok! (translate-indt I EQT) "derive.eqType.ast: translate", std.assert-ok! (validate-eqType EQT) "derive.eqType.ast: validate", C = (eqType I EQT), coq.elpi.accumulate _ "derive.eqType.db" (clause _ _ C). } namespace feqb { pred trm->term i:trm, o:term. trm->term (global GR) (global GR) :- !. trm->term (app GR A AS) (app[global GR,A1|AS1]) :- !, trm->term A A1, std.map AS trm->term AS1. trm->term T _ :- coq.error "cannot translate trm" T "to term, did you forget to assume feqb.trm->term ?". } coq-elpi-1.19.3/apps/derive/elpi/eqb.elpi000066400000000000000000000242051451177652200201270ustar00rootroot00000000000000/* equality test generation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ macro @pi-trm N T F :- pi x xx\ decl x N T => (feqb.trm->term xx x :- !) => F xx x. pred derive.eqb.main i:gref, i:string, o:list prop. derive.eqb.main (indt I) Prefix CL :- std.do! [ std.assert! (eqType I FI) "this inductive is not supported", derive.eqb.eqbf.main FI FI [] [] R, std.assert-ok! (coq.typecheck R Rty) "derive.eqbf generates illtyped term", Name is Prefix ^ "eqb_fields", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R Rty ff C, EQBF = global (const C), derive.eqb.eqb.main FI FI [] [] EQBF R1Skel, std.assert-ok! (coq.elaborate-skeleton R1Skel R1ty R1) "derive.eqb generates illtyped term", % need elaborate for prim record Name1 is Prefix ^ "eqb", coq.ensure-fresh-global-id Name1 FName1, coq.env.add-const FName1 R1 R1ty ff C1, EQB = global (const C1), % populate dbs derive.eqb.eqbf.do-clause FI FI [] [] EQBF [] CL1, derive.eqb.eqb.do-clause FI FI [] [] EQB [] CL2, CL = [CL1,CL2,eqb-done (indt I)], std.forall CL (x\ coq.elpi.accumulate _ "derive.eqb.db" (clause _ _ x)), ]. derive.eqb.main (const C) Prefix CL :- std.do! [ coq.env.const C (some T) _, std.assert! (eqb-for T T EQB) "cannot derive eqb", Name is Prefix ^ "eqb", coq.ensure-fresh-global-id Name FName, X = global (const C), coq.env.add-const FName EQB {{ lp:X -> lp:X -> bool }} @transparent! EQBC, CL = [eqb-done (const C), eqb-for (global (const C)) (global (const C)) (global (const EQBC))], std.forall CL (x\ coq.elpi.accumulate _ "derive.eqb.db" (clause _ (before "eqb-for:whd") x)), ]. derive.eqb.main (indc _) _ _ :- stop "eqrive.eqb cannot be called on constructors". namespace derive.eqb.eqb { % ----------------------------------------------------------------------------- pred main i:eqType, i:eqType, i:list term, i:list term, i:term, o:term. main (type-param FI) (type-param FJ) PI PJ EF {{ fun (x : Type) (eqx : x -> x -> bool) => lp:(R x eqx) }} :- @pi-trm `x` {{ Type }} y\x\ @pi-decl `eqx` {{ lp:x -> lp:x -> bool }} eqx\ main (FI y) (FJ y) [x|PI] [x|PJ] {coq.mk-app EF [x,eqx]} (R x eqx). main (value-param TYI FI) (value-param TYJ FJ) PI PJ EF {{ fun (x : lp:TI) (y : lp:TJ) => lp:(R x y) }} :- feqb.trm->term TYI TI, feqb.trm->term TYJ TJ, @pi-trm `x` TI xx\x\ @pi-trm `y` TJ yy\y\ main (FI xx) (FJ yy) [x|PI] [y|PJ] {coq.mk-app EF [x,y]} (R x y). main (inductive Ind _) (inductive Ind _) PI PJ EF {{ fix rec (x1 : lp:I) (x2 : lp:J) {struct x1} : bool := lp:(R rec x1 x2) }} :- coq.env.recursive? Ind, !, coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J, @pi-decl `rec` {{ lp:I -> lp:J -> bool }} rec\ @pi-decl `x1` I x1\ @pi-decl `x2` J x2\ do-match x1 I x2 J {coq.mk-app EF [rec]} (R rec x1 x2). main (inductive Ind _) (inductive Ind _) PI PJ EF {{ fun (x1 : lp:I) (x2 : lp:J) => lp:(R x1 x2) }} :- coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J, @pi-decl `x1` I x1\ @pi-decl `x2` J x2\ do-match x1 I x2 J {coq.mk-app EF [{{fun (_ : lp:I) (_ : lp:J) => true}}]} (R x1 x2). % ----------------------------------------------------------------------------- pred do-match i:term, i:term, i:term, i:term, i:term, o:term. do-match X1 I X2 J F R :- coq.build-match X1 I (_\_\_\r\ r = {{ bool }}) (do-branch X2 J F) R. % ----------------------------------------------------------------------------- pred do-branch i:term, i:term, i:term, i:term, i:term, i:list term, i:list term, o:term. do-branch X2 J F K KTY Vars _ {{ @eqb_core_defs.eqb_body _ _ _ _ lp:FLDP lp:F lp:TAG lp:X lp:X2 }} :- std.do! [ coq.safe-dest-app KTY (global (indt I)) ParamsI, std.assert! (fields-for I _ FLD _ _) "derive.eqb: run derive.fields before", coq.safe-dest-app J _ ParamsJ, coq.mk-app (global (const FLD)) ParamsJ FLDP, std.assert! (tag-for I T) "derive.eqb: run derive.tag before", coq.mk-app (global (const T)) {std.append ParamsI [{coq.mk-app K Vars}]} TAG, coq.safe-dest-app K (global (indc KI)) _, std.assert! (box-for KI _ BK) "derive.eqb: run derive.fields before", coq.mk-app (global (indc BK)) {std.append ParamsI Vars} X, ]. % ----------------------------------------------------------------------------- % example: eqb-for {{ list lp:A }} {{ @list_eqb lp:A lp:F }} :- eqb-for A F. pred do-clause i:eqType, i:eqType, i:list term, i:list term, i:term, i:list prop, o:prop. do-clause (type-param AI) (type-param AJ) PI PJ F Todo (pi a ea\ C a ea) :- !, pi x a ea\ do-clause (AI x) (AJ x) [a|PI] [a|PJ] {coq.mk-app F [a,ea]} [eqb-for a a ea|Todo] (C a ea). do-clause (value-param _ AI) (value-param _ AJ) PI PJ F Todo (pi a b\ C a b) :- !, pi x a b\ do-clause (AI x) (AJ x) [a|PI] [b|PJ] {coq.mk-app F [a,b]} Todo (C a b). do-clause (inductive Ind _) (inductive Ind _) PI PJ F Todo (eqb-for I J F :- Todo) :- coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J. } namespace derive.eqb.eqbf { % ----------------------------------------------------------------------------- pred main i:eqType, i:eqType, i:list term, i:list term, o:term. main (type-param FI) (type-param FJ) PI PJ {{ fun (p : Type) (eqp : p -> p -> bool) => lp:(R p eqp) }} :- @pi-trm `P` {{ Type }} x\p\ @pi-decl `eqP` {{ lp:p -> lp:p -> bool }} eqP\ eqb-for p p eqP => main (FI x) (FJ x) [p|PI] [p|PJ] (R p eqP). main (value-param TYI FI) (value-param TYJ FJ) PI PJ {{ fun (x y : lp:T) => lp:(R x y) }} :- feqb.trm->term TYI TI, feqb.trm->term TYJ TJ, @pi-trm `P` TI xx\x\ @pi-trm `P` TJ yy\y\ main (FI xx) (FJ yy) [x|PI] [y|PJ] (R x y). main (inductive Ind F) (inductive Ind G) PI PJ {{ fun (rec : lp:I -> lp:J -> bool) (x : positive) => lp:(R rec x) }} :- std.do! [ std.rev PI ParamsI, std.rev PJ ParamsJ, coq.mk-app (global (indt Ind)) ParamsI I, coq.mk-app (global (indt Ind)) ParamsJ J, std.assert! (fields-for Ind F_t _ _ _) "derive.eqb: run derive.fields before", coq.mk-app (global (const F_t)) ParamsI Fields_t_I, coq.mk-app (global (const F_t)) ParamsJ Fields_t_J, (@pi-decl `rec` {{ lp:I -> lp:J -> bool }} rec\ @pi-decl `x` {{ positive }} x\ eqb-for I J rec => pi i j\ (feqb.trm->term i I :- !) => (feqb.trm->term j J :- !) => derive.fields.splay-over-positive x {std.zip (F i) (G j)} (rty Fields_t_I Fields_t_J) {{ fun (_ : lib:elpi.derive.unit) (_ : lib:elpi.derive.unit) => true }} (fields ParamsI ParamsJ) (R rec x)), ]. pred rty i:term, i:term, i:term, o:term. rty Fields_t_I Fields_t_J X {{ lp:Fields_t_I lp:X -> lp:Fields_t_J lp:X -> bool }}. % ----------------------------------------------------------------------------- pred fields i:list term, i:list term, i:pair constructor constructor, o:term. fields ParamsI ParamsJ (pr (constructor K (stop _)) (constructor K (stop _))) {{ fun (a : lp:BoxTy1) (b : lp:BoxTy2) => true }} :- std.do! [ std.assert! (box-for K IB _) "derive.eqb: run derive.fields before", coq.mk-app (global (indt IB)) ParamsI BoxTy1, coq.mk-app (global (indt IB)) ParamsJ BoxTy2, ]. fields ParamsI ParamsJ (pr (constructor K Args) (constructor K Args2)) {{ fun (a : lp:BoxTy1) (b : lp:BoxTy2) => lp:(R a b) }} :- std.do! [ std.assert! (box-for K IB _) "derive.eqb: run derive.fields before", coq.mk-app (global (indt IB)) ParamsI BoxTy1, coq.mk-app (global (indt IB)) ParamsJ BoxTy2, @pi-decl `a` BoxTy a\ @pi-decl `b` BoxTy b\ coq.build-match a BoxTy1 fields.rty1 (fields.branch1 b BoxTy2 Args Args2) (R a b) ]. pred fields.rty1 i:term, i:list term, i:list term, o:term. fields.rty1 _ _ _ {{ bool }}. pred fields.branch1 i:term, i:term, i:arguments, i:arguments, i:term, i:term, i:list term, i:list term, o:term. fields.branch1 B BoxTy2 Args Args2 _ _ VarsA _ R :- coq.build-match B BoxTy2 fields.rty2 (fields.branch2 Args Args2 VarsA) R. pred fields.rty2 i:term, i:list term, i:list term, o:term. fields.rty2 _ _ _ {{ bool }}. pred fields.branch2 i:arguments, i:arguments, i:list term, i:term, i:term, i:list term, i:list term, o:term. fields.branch2 Args Args2 VarsA _ _ VarsB _ R :- fields.aux Args Args2 VarsA VarsB R. pred mk-eqb-for i:term, i:term, o:term. mk-eqb-for T1 T2 R :- eqb-for T1 T2 R, !. mk-eqb-for T1 _ _ :- Msg is "derive.eqb: missing boolean equality for " ^ {coq.term->string T1} ^ ", maybe use derive.eqb first", stop Msg. pred fields.aux i:arguments, i:arguments, i:list term, i:list term, o:term. fields.aux (dependent TYX FX) (dependent TYY FY) [X|XS] [Y|YS] {{ lib:elpi.andb (lp:EQB lp:X lp:Y) lp:R1 }} :- feqb.trm->term TYX TX, feqb.trm->term TYY TY, mk-eqb-for TX TY EQB, @pi-decl `p` TX n\ pi a\ (feqb.trm->term a n :- !) => @pi-decl `p` TY m\ pi b\ (feqb.trm->term b m :- !) => fields.aux (FX a) (FY b) XS YS (R n m), R1 = R X Y. fields.aux (regular TYX FX) (regular TYY FY) [X|XS] [Y|YS] {{ lib:elpi.andb (lp:EQB lp:X lp:Y) lp:R }} :- feqb.trm->term TYX TX, feqb.trm->term TYY TY, mk-eqb-for TX TY EQB, fields.aux FX FY XS YS R. fields.aux (irrelevant _ FX) (irrelevant _ FY) [_|XS] [_|YS] R :- fields.aux FX FY XS YS R. fields.aux (stop _) (stop _) [] [] {{ true }}. % ----------------------------------------------------------------------------- % example: % eqb-fields {{ list lp:A }} {{ @list_eqb_fields lp:A lp:EA lp:ELA }} :- % eqb-for A EA, eqb-for {{ list lp:A }} ELA. pred do-clause i:eqType, i:eqType, i:list term, i:list term, i:term, i:list prop, o:prop. do-clause (type-param AI) (type-param AJ) PI PJ F Todo (pi a ea\ C a ea) :- !, pi x a ea\ do-clause (AI x) (AJ x) [a|PI] [a|PJ] {coq.mk-app F [a,ea]} [eqb-for a a ea|Todo] (C a ea). do-clause (value-param _ AI) (value-param _ AJ) PI PJ F Todo (pi a b\ C a b) :- !, pi x a b\ do-clause (AI x) (AJ x) [a|PI] [b|PJ] {coq.mk-app F [a,b]} Todo (C a b). do-clause (inductive Ind _) (inductive Ind _) PI PJ F Todo (pi ela\ eqb-fields I J (F1 ela) :- [C ela|Todo]) :- !, coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J, pi ela\ (coq.mk-app F [ela] (F1 ela), C ela = eqb-for I J ela). } coq-elpi-1.19.3/apps/derive/elpi/eqbOK.elpi000066400000000000000000000051471451177652200203650ustar00rootroot00000000000000/* equality test soundness proof */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ macro @pi-trm N T F :- pi x xx\ decl x N T => (feqb.trm->term xx x :- !) => F xx x. namespace derive.eqbOK { pred add-reflect i:eqType, i:term, i:term, o:term. add-reflect (type-param F) Correct Refl {{ fun (a : lp:Type) (eqA: a -> a -> bool) (heqA : lp:(HeqA a eqA)) => lp:(R a eqA heqA) }} :- Type = sort (typ {coq.univ.new}), HeqA = (a\eqA\ {{ forall x1 x2 : lp:a, reflect (@eq lp:a x1 x2) (lp:eqA x1 x2) }}), @pi-trm `a` Type aa\a\ @pi-decl `eqA` {{ lp:a -> lp:a -> bool }} eqA\ @pi-decl `heqA` (HeqA a eqA) heqA\ add-reflect (F aa) {{lp:Correct lp:a lp:eqA (fun (a1 a2 : lp:a) => @elimT (@eq lp:a a1 a2) (lp:eqA a1 a2) (lp:heqA a1 a2))}} {{lp:Refl lp:a lp:eqA (fun (a1: lp:a) => @introT (@eq lp:a a1 a1) (lp:eqA a1 a1) (lp:heqA a1 a1) (@refl_equal lp:a a1))}} (R a eqA heqA). add-reflect (value-param TY F) Correct Refl {{ fun x : lp:Ty => lp:(R x) }} :- feqb.trm->term TY Ty, @pi-trm `x` Ty xx\x\ add-reflect (F xx) {{lp:Correct lp:x}} {{lp:Refl lp:x}} (R x). add-reflect (inductive _ _) Correct Refl {{iffP2 lp:Correct lp:Refl}}. pred main i:gref, i:string, o:list prop. main (indt I) Prefix [CL] :- std.do! [ std.assert! (eqType I FI) "this inductive is not supported", std.assert! (eqcorrect-for (indt I) Correct Refl) "run eqbcorrect before", add-reflect FI (global (const Correct)) (global (const Refl)) Breflect, std.assert-ok! (coq.typecheck Breflect Treflect) "eqbOK generates illtyped term", coq.ensure-fresh-global-id (Prefix ^ "eqb_OK") Namerf, coq.env.add-const Namerf Breflect Treflect @opaque! Reflect, CL = eqbok-for (indt I) Reflect, coq.elpi.accumulate _ "derive.eqbOK.db" (clause _ _ CL), ]. main (const C) Prefix [CL] :- std.do! [ std.assert! (eqb-for (global (const C)) (global (const C)) F) "run eqb before", std.assert! (eqcorrect-for (const C) Correct Refl) "run eqbcorrect before", add-reflect (inductive _ _) (global (const Correct)) (global (const Refl)) Breflect, std.assert-ok! (coq.typecheck Breflect _) "eqbOK generates illtyped term", coq.ensure-fresh-global-id (Prefix ^ "eqb_OK") Namerf, X = global (const C), coq.env.add-const Namerf Breflect {{ forall a b : lp:X, Bool.reflect (@eq lp:X a b) (lp:F a b) }} @opaque! Reflect, CL = eqbok-for (const C) Reflect, coq.elpi.accumulate _ "derive.eqbOK.db" (clause _ _ CL), ]. main (indc _) _ _ :- stop "cannot call eqbOK on a constructor". } coq-elpi-1.19.3/apps/derive/elpi/eqbcorrect.elpi000066400000000000000000000447361451177652200215240ustar00rootroot00000000000000/* equality test correctness and reflexivity proof */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ macro @pi-trm N T F :- pi x xx\ decl x N T => (feqb.trm->term xx x :- !) => F xx x. namespace derive.eqbcorrect { pred has-params? i:eqType. has-params? (type-param _). has-params? (value-param _ _). % use: % config Pred Pred_on Pred_body Solver Db % to make the code agnostic on the proof of correctness or reflexivity % % eg: config {{ @eqb_correct }} {{ @eqb_correct_on }} {{ @eqb_body_correct }} "eqb_correct_on__solver" correct-lemma-for pred config o:term, o:term, o:term, o:string, o:(term -> term -> prop). pred main i:gref, i:string, o:list prop. main (indt I) Prefix CLs :- std.do! [ std.assert! (eqType I FI) "this inductive is not supported", std.assert! (induction-db I Indu) "call derive.induction before", /* Correctness */ config {{ @eqb_correct }} {{ @eqb_correct_on }} {{ @eqb_body_correct }} "eqb_correct_on__solver" correct-lemma-for => common FI [] Indu R, %std.assert! (ground_term R) "ww", std.assert-ok! (coq.typecheck R Ty) "derive.eqbcorrect: common/correct generates ill typed term", Name is Prefix ^ "eqb_correct", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R Ty @opaque! Correct, if (has-params? FI) ( config {{ @eqb_correct }} {{ @eqb_correct_on }} {{ @eqb_body_correct }} "eqb_correct_on__solver" correct-lemma-for => common-aux FI [] Indu Rx, std.assert-ok! (coq.typecheck Rx Tyx) "derive.eqbcorrect: common-aux/corect generates ill typed term", Namex is Prefix ^ "eqb_correct_aux", coq.ensure-fresh-global-id Namex FNamex, coq.env.add-const FNamex Rx Tyx @opaque! Correctx, CL_CORRECT = [correct-lemma-for (global (indt I)) (global (const Correctx))] ) (CL_CORRECT = [correct-lemma-for (global (indt I)) (global (const Correct))]), /* Reflexivity */ config {{ @eqb_reflexive }} {{ @eqb_refl_on }} {{ @eqb_body_refl }} "eqb_refl_on__solver" refl-lemma-for => common FI [] Indu Rr, std.assert-ok! (coq.typecheck Rr Tyr) "derive.eqbcorrect: common/refl generates ill typed term", Namer is Prefix ^ "eqb_refl", coq.ensure-fresh-global-id Namer FNamer, coq.env.add-const FNamer Rr Tyr @opaque! Refl, if (has-params? FI) ( config {{ @eqb_reflexive }} {{ @eqb_refl_on }} {{ @eqb_body_refl }} "eqb_refl_on__solver" refl-lemma-for => common-aux FI [] Indu Rrx, std.assert-ok! (coq.typecheck Rrx Tyrx) "derive.eqbcorrect: common-aux/refl generates ill typed term", Namerx is Prefix ^ "eqb_refl_aux", coq.ensure-fresh-global-id Namerx FNamerx, coq.env.add-const FNamerx Rrx Tyrx @opaque! Reflx, CL_REFL = [refl-lemma-for (global (indt I)) (global (const Reflx))] ) (CL_REFL = [refl-lemma-for (global (indt I)) (global (const Refl))]), /* Add the clauses in the database */ std.flatten [ [ eqcorrect-for (indt I) Correct Refl ] , CL_CORRECT , CL_REFL ] CLs , std.forall CLs (x\coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ x)), ]. main (const C) Prefix [Clause] :- std.do! [ std.assert! (eqb-for (global (const C)) (global (const C)) F) "run eqb first", coq.env.const C (some T) _, search-eqcorrect-for T Correct Refl, std.assert-ok! (coq.typecheck Correct _) "eqbcorrect: illtyped correct", std.assert-ok! (coq.typecheck Refl _) "eqbcorrect: illtyped refl", NameR is Prefix ^ "eqb_refl", NameC is Prefix ^ "eqb_correct", X = global (const C), coq.ensure-fresh-global-id NameR FNameR, coq.ensure-fresh-global-id NameC FNameC, coq.env.add-const FNameC Correct {{ @eqb_correct lp:X lp:F }} @transparent! CC, coq.env.add-const FNameR Refl {{ @eqb_reflexive lp:X lp:F }} @transparent! CR, Clause = (eqcorrect-for (const C) CC CR), coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ Clause), ]. main (indc _) _ _ :- stop "derive.eqbcorrect does not work on a constructor". %--------------------------------------------------------------------------- pred search-eqcorrect-for i:term, o:term, o:term. search-eqcorrect-for (global (indt I)) (global (const C)) (global (const R)) :- std.assert! (eqType I (inductive _ _)) "unknown or not applied enough type", eqcorrect-for (indt I) C R. search-eqcorrect-for (app[global (indt I)|Args]) CArgs RArgs :- std.assert! (eqType I F) "unknown", eqcorrect-for (indt I) C R, search-eqcorrect-apply F Args (global (const C)) (global (const R)) CArgs RArgs. pred search-eqcorrect-apply i:eqType, i:list term, i:term, i:term, o:term, o:term. search-eqcorrect-apply (type-param F) [T|Args] C R C1 R1 :- search-eqcorrect-for T CT RT, pi x\ search-eqcorrect-apply (F x) Args {coq.mk-app C [T,_,CT]} {coq.mk-app R [T,_,RT]} C1 R1. search-eqcorrect-apply (value-param _ F) [T|Args] C R C1 R1 :- pi x\ search-eqcorrect-apply (F x) Args {coq.mk-app C [T]} {coq.mk-app R [T]} C1 R1. search-eqcorrect-apply (inductive _ _) [] C R C R. %--------------------------------------------------------------------------- pred run-solver i:sealed-goal, i:string. run-solver G Name :- if (coq.ltac.open (coq.ltac.call Name []) G []) true (@holes! => coq.sealed-goal->string G SG, std.fatal-error {calc ( "solver " ^ Name ^ " fails on goal:\n" ^ SG )}). pred coq.sealed-goal->string i:sealed-goal, o:string. coq.sealed-goal->string (nabla G) R :- pi x\ coq.sealed-goal->string (G x) R. coq.sealed-goal->string (seal (goal Ctx _ Ty _ _)) R :- Ctx => (std.map {std.rev Ctx} coq.ctx->string L, coq.term->string Ty G, R is "Lemma foo " ^ {std.string.concat "\n" L} ^ "\n :\n" ^ G ^ "."). pred coq.ctx->string i:prop, o:string. coq.ctx->string (decl X _ Ty) R :- R is "(" ^ {coq.term->string X} ^ " : " ^ {coq.term->string Ty} ^ ")". coq.ctx->string (def X _ Ty B) R :- R is "(" ^ {coq.term->string X} ^ " : " ^ {coq.term->string Ty} ^ " := " ^ {coq.term->string B} ^ ")". pred common-body o:term. pred fields-t o:term, o:term, o:term, o:term. %--------------------------------------------------------------------------- pred common i:eqType, i:list term, i:term, o:term. common (type-param F) Params Ind O :- std.do! [ config Pred Pred_on _Pred_body _Solver Db, O = {{ fun (a : lp:Type) (eqA : a -> a -> bool) (eqAc : lp:Pred a eqA) => lp:(R a eqA eqAc) }}, Type = sort (typ {coq.univ.new}), @pi-trm `a` Type aa\a\ @pi-decl `eqA` {{ lp:a -> lp:a -> bool }} eqA\ @pi-decl `eqAc` {{ lp:Pred lp:a lp:eqA }} eqAc\ param1-inhab-db {{ lp:Pred_on lp:a lp:eqA }} eqAc => eqb-for a a eqA => reali a {{ lp:Pred_on lp:a lp:eqA }} => prove Db a {{ fun (x: lp:a) (Hx : lp:Pred_on lp:a lp:eqA x) => Hx }} => common (F aa) [a|Params] {coq.mk-app Ind [a, {{ lp:Pred_on lp:a lp:eqA }} ] } (R a eqA eqAc) ]. common (value-param TY F) Params Ind O :- std.do! [ feqb.trm->term TY T, O = {{ fun (a : lp:T) => lp:(R a) }}, mk-reali T TR, std.assert! (param1-inhab-db TR Is_full) "not trivially inhabited", @pi-trm `a` T aa\a\ reali a {{ lp:Is_full lp:a }} => common (F aa) [a|Params] {{ lp:Ind lp:a (lp:Is_full lp:a) }} (R a) ]. common (inductive I Ks) ParamsRev Ind O :- std.do! [ config _Pred Pred_on Pred_body _Solver Db, std.rev ParamsRev Params, coq.mk-app (global (indt I)) Params Ty, mk-eqb-for Ty Cmp, tag-for I TagC, fields-for I Fields_tC FieldsC ConstructC ConstructPC, coq.mk-app (global (const TagC)) Params Tag, coq.mk-app (global (const Fields_tC)) Params Fields_t, coq.mk-app (global (const FieldsC)) Params Fields, coq.mk-app (global (const ConstructC)) Params Construct, coq.mk-app (global (const ConstructPC)) Params ConstructP, eqb-fields Ty Ty EqbFields, Common = {{ lp:Pred_body lp:Ty lp:Tag lp:Fields_t lp:Fields lp:Construct lp:ConstructP lp:EqbFields }}, std.assert-ok! (coq.typecheck Common CommonTy) "WTF", mk-reali (global (indt I)) IR, % param1-db, really coq.safe-dest-app Ind _ RealiArgs, coq.mk-app IR RealiArgs TyR, std.assert! (param1-inhab-db TyR Is_full) "not trivially inhabited", mk-eqb-for Ty Cmp, (@pi-decl `x` Ty x\ @pi-def `common` CommonTy Common c\ common-body c => fields-t Tag Fields_t Fields Construct => prove Db Ty {{ fun (i : lp:Ty) (Hi : lp:Pred_on lp:Ty lp:Cmp i) => Hi }} => reali Ty {{ lp:Pred_on lp:Ty lp:Cmp }} => pi i\ (feqb.trm->term i Ty :- !) => std.do! [ std.map (Ks i) (branch Params) (LS c), std.append (LS c) [x, app[Is_full,x]] (Args x c), R x c = app [Ind, {{ lp:Pred_on lp:Ty lp:Cmp }} | Args x c], ]), O = {{ fun (x :lp:Ty) (common : lp:CommonTy := lp:Common) => lp:(R x common) }}, ]. %--------------------------------------------------------------------------- pred common-aux i:eqType, i:list term, i:term, o:term. common-aux (type-param F) Params Ind O :- std.do! [ config _Pred Pred_on _Pred_body _Solver Db, O = {{ fun (a : lp:Type) (eqA : a -> a -> bool) => lp:(R a eqA) }}, Type = sort (typ {coq.univ.new}), @pi-trm `a` Type aa\a\ @pi-decl `eqA` {{ lp:a -> lp:a -> bool }} eqA\ eqb-for a a eqA => reali a {{ lp:Pred_on lp:a lp:eqA }} => prove Db a {{ fun (x: lp:a) (Hx : lp:Pred_on lp:a lp:eqA x) => Hx }} => common-aux (F aa) [a|Params] {coq.mk-app Ind [a, {{ lp:Pred_on lp:a lp:eqA }} ] } (R a eqA) ]. common-aux (value-param TY F) Params Ind O :- std.do! [ feqb.trm->term TY T, O = {{ fun (a : lp:T) (pa : lp:TR a) => lp:(R a pa) }}, mk-reali T TR, @pi-trm `a` T aa\a\ @pi-decl `pa` {{ lp:TR lp:a }} pa\ reali a pa => common-aux (F aa) [a|Params] {{ lp:Ind lp:a lp:pa }} (R a pa) ]. common-aux (inductive I Ks) ParamsRev Ind O :- std.do! [ config _Pred Pred_on Pred_body _Solver Db, std.rev ParamsRev Params, coq.mk-app (global (indt I)) Params Ty, mk-eqb-for Ty Cmp, tag-for I TagC, fields-for I Fields_tC FieldsC ConstructC ConstructPC, coq.mk-app (global (const TagC)) Params Tag, coq.mk-app (global (const Fields_tC)) Params Fields_t, coq.mk-app (global (const FieldsC)) Params Fields, coq.mk-app (global (const ConstructC)) Params Construct, coq.mk-app (global (const ConstructPC)) Params ConstructP, eqb-fields Ty Ty EqbFields, Common = {{ lp:Pred_body lp:Ty lp:Tag lp:Fields_t lp:Fields lp:Construct lp:ConstructP lp:EqbFields }}, std.assert-ok! (coq.typecheck Common CommonTy) "WTF", prove Db Ty {{ fun (i : lp:Ty) (Hi : lp:Pred_on lp:Ty lp:Cmp i) => Hi }} => reali Ty {{ lp:Pred_on lp:Ty lp:Cmp }} => (pi i\ (feqb.trm->term i Ty :- !) => @pi-def `common` CommonTy Common c\ common-body c => fields-t Tag Fields_t Fields Construct => std.map (Ks i) (branch Params) (LS c)), O = (let `common` CommonTy Common c\ app [Ind, {{ lp:Pred_on lp:Ty lp:Cmp }} | LS c]), ]. %--------------------------------------------------------------------------- pred branch i:list term, i:constructor, o:term. branch Params (constructor K Args) R :- coq.mk-app (global (indc K)) Params KParams, args Args KParams [] [] [] 0 R. pred args i:arguments, i:term, i:list term,i:list term, i:list term, i:int, o:term. args (irrelevant TY Args) K As Hs Bs N O :- std.do! [ O = {{ fun (x : lp:T) (px : lp:EqbOn x) => lp:(R x px) }}, feqb.trm->term TY T, mk-reali T EqbOn, @pi-decl `x` T x\ @pi-decl `px` {{ lp:EqbOn lp:x }} px\ args Args {coq.mk-app K [x]} [x|As] Hs Bs {calc (N + 1)} (R x px) ]. args (regular TY Args) K As Hs Bs N O :- std.do! [ config _Pred Pred_on _Pred_body _Solver Db, O = {{ fun (x : lp:T) (px : lp:EqbOn x) (h : lp:EqbOn' x := lp:View x px) => lp:(R x px h) }}, feqb.trm->term TY T, mk-reali T EqbOn, mk-eqb-for T Cmp, EqbOn' = {{ lp:Pred_on lp:T lp:Cmp }}, if (same_term EqbOn EqbOn') (View = {{ fun (x : lp:T) (px : lp:EqbOn x) => px }}) (prove Db T View), @pi-decl `x` T x\ @pi-decl `px` {{ lp:EqbOn lp:x }} px\ % reali x px => @pi-def `h` {{ lp:EqbOn' lp:x }} {{ lp:View lp:x lp:px }} h\ args Args {coq.mk-app K [x]} [x|As] [h|Hs] [{{ lp:Cmp lp:x }}|Bs] N (R x px h) ]. args (dependent TY Args) K As Hs Bs N O :- std.do! [ config _Pred Pred_on _Pred_body _Solver Db, O = {{ fun (x : lp:T) (px : lp:EqbOn x) (h : lp:EqbOn' x := lp:View x px) => lp:(R x px h) }}, feqb.trm->term TY T, mk-reali T EqbOn, mk-eqb-for T Cmp, EqbOn' = {{ lp:Pred_on lp:T lp:Cmp }}, if (same_term EqbOn EqbOn') (View = {{ fun (x : lp:T) (px : lp:EqbOn x) => px }}) (prove Db T View), @pi-trm `x` T xx\x\ @pi-decl `px` {{ lp:EqbOn lp:x }} px\ reali x px => @pi-def `h` {{ lp:EqbOn' lp:x }} {{ lp:View lp:x lp:px }} h\ args (Args xx) {coq.mk-app K [x]} [x|As] [h|Hs] [{{ lp:Cmp lp:x }}|Bs] {calc (N + 1)} (R x px h) ]. args (stop TY) K As Hs Bs 0 {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} :- % no tricky arguments config {{ @eqb_correct }} Pred_on _Pred_body _Solver _Db, !, std.do! [ feqb.trm->term TY T, mk-eqb-for T Cmp, fields-t Tag Fields_t Fields Construct, eqb-fields T T EqbFields, std.assert! (common-body Common) "anomaly, no let for common body proof", coq.mk-app Common [K,{{ fun (x : lp:Fields_t (lp:Tag lp:K)) => lp:(Proof x) }}] B, @pi-decl `x` {{ lp:Fields_t (lp:Tag lp:K) }} x\ HYP = (x\ {{ @eq bool (lp:EqbFields (lp:Tag lp:K) (lp:Fields lp:K) lp:x) true }}), GOAL = (x\ {{ @eq (option lp:T) (@Some lp:T lp:K) (lp:Construct (lp:Tag lp:K) lp:x) }}), correct-proof x {{ lp:Fields_t (lp:Tag lp:K) }} HYP GOAL As Bs Hs (Proof x) ]. args (stop TY) K _As _Hs _Bs _ {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} :- config {{ @eqb_correct }} Pred_on _Pred_body Solver _Db, !, std.do! [ feqb.trm->term TY T, mk-eqb-for T Cmp, std.assert! (common-body Common) "anomaly, no let for common body proof", coq.mk-app Common [K,Fresh_] B, std.assert-ok! (coq.typecheck {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} _) "illtyped correctness proof", std.assert! (coq.ltac.collect-goals B [G] _) "wrong number of goals", run-solver G Solver, ]. pred correct-proof i:term, i:term, i:(term -> term), i:(term -> term) i:list term, i:list term, i:list term, o:term. correct-proof X TX H G As Bs Hs R :- coq.build-match X TX (cp.rty H G) (cp.bs As Bs Hs G) R. pred cp.rty i:(term -> term), i:(term -> term), i:term, i:list term, i:list term, o:term. cp.rty H G _ Vs _ {{ lp:{{ H X }} -> lp:{{ G X }} }} :- std.last Vs X. pred cp.bs i:list term, i:list term, i:list term, i:(term -> term), i:term, i:term, i:list term, i:list term, o:term. cp.bs As Bs Hs G K _ Vs Ts {{ @impliesP lp:Bools lp:P lp:Next }} :- std.rev Vs VsRev, mkblistcorrect Bs VsRev {{ bnil }} Bools, P = G {coq.mk-app K Vs }, cp.curry {std.rev Bs} As Vs Vs Ts Hs [] G K Next. pred cp.curry i:list term, i:list term, i:list term, i:list term, i:list term, i:list term, i:list term, i:(term -> term), i:term, o:term. cp.curry [B|Bs] As [V|Vs] OVs Ts Hs Hs2 G K W :- std.do! [ TyH = {{ @eq bool (lp:B lp:V) true }}, (@pi-decl `h` TyH h\ cp.curry Bs As Vs OVs Ts Hs [h|Hs2] G K (R h)), W = {{ fun h : lp:TyH => lp:(R h) }}, ]. cp.curry [] As [] Vs Ts Hs Hs2 G K R :- std.do! [ mktlistcorrect {std.rev Ts} {{ tnil }} Types, mkrewpred Ts K G P, (pi x\ sigma X\G x = {{ @eq lp:T lp:LHS lp:X }}), End = {{ @eq_refl lp:T lp:LHS }}, mkeqns {std.rev As} Vs {std.rev Hs} {std.rev Hs2} Eqns, coq.mk-app {{ @eq_ind_r_nP lp:Types lp:P }} {std.append Eqns [End]} R, ]. pred mkrewpred i:list term, i:term, i:(term -> term), o:term. mkrewpred [] K G (G K). mkrewpred [T|Ts] K G {{ fun w : lp:T => lp:(R w) }} :- @pi-decl `w` T w\ mkrewpred Ts {coq.mk-app K [w]} G (R w). pred mkeqns i:list term, i:list term, i:list term, i:list term, o:list term. mkeqns [] [] [] [] []. mkeqns [A|As] [V|Vs] [H|Hs] [H2|H2s] [A,V,{{ lp:H lp:V lp:H2 }}|R] :- mkeqns As Vs Hs H2s R. pred mktlistcorrect i:list term, i:term, o:term. mktlistcorrect [] ACC ACC. mktlistcorrect [X|XS] ACC R :- mktlistcorrect XS {{ tcons lp:X lp:ACC }} R. pred mkblistcorrect i:list term, i:list term, i:term, o:term. mkblistcorrect [] [] ACC ACC. mkblistcorrect [X|XS] [V|VS] ACC R :- coq.mk-app X [V] E, mkblistcorrect XS VS {{ bcons lp:E lp:ACC }} R. args (stop TY) K _As Hs Bs _ {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} :- config {{ @eqb_reflexive }} Pred_on _Pred_body _Solver _Db, !, std.do! [ feqb.trm->term TY T, mk-eqb-for T Cmp, std.assert! (common-body Common) "anomaly, no let for common body proof", mkblistrefl {std.rev Bs} {{ bnil }} Bools, Proof = app [ {{ @eqb_refl_statementP }} , Bools | Hs ], coq.mk-app Common [K,Proof] B, ]. pred mkblistrefl i:list term, i:term, o:term. mkblistrefl [] ACC ACC. mkblistrefl [X|XS] ACC R :- coq.safe-dest-app X _ Args, std.last Args A, coq.mk-app X [A] E, mkblistrefl XS {{ bcons lp:E lp:ACC }} R. %--------------------------------------------------------------------------- % prove {{ is_option (seq A) (is_seq A (eqb_correrct A eqA)) }} T % such that T has type {{ forall x (px : is_option ...), eqb_correrct (option (seq A)) x }} pred prove i:(term -> term -> prop), i:term, o:term. prove Lemma T R :- search Lemma (prove Lemma) T R. %prove T R :- whd1 T T', !, prove T' R. pred search i:(term -> term -> prop), i:(term -> term -> prop), i:term, o:term. search What Rec (app [GR|L] as GRL) R :- !, std.do! [ What GR Aux, mk-reali GR (global (indt ISGR)), param1-functor-for ISGR Funct BitMask, !, apply-functor (global Funct) BitMask L Rec TOTO, apply-aux Aux L Aux1, R = {{ fun (x : lp:GRL) H => lp:Aux1 x (lp:TOTO x H) }}, ]. % no params, no aux lemma (no reali argument) search What _Rec (global GR as GRL) {{ fun (x : lp:GRL) (_ : lp:IsGR x) => lp:R x }} :- What (global GR) R, mk-reali (global GR) IsGR, !. search What _ X _ :- coq.safe-dest-app X HD _, std.assert! (What HD _) "run eqbcorrect before". pred apply-aux i:term, i:list term, o:term. apply-aux Aux [] Aux. apply-aux Aux [T|L] Aux1 :- !, std.do![ std.assert! (eqb-for T T EQB ; reali T EQB) "WTF", apply-aux {coq.mk-app Aux [T, EQB]} L Aux1 ]. pred apply-functor i:term, i:list bool, i:list term, i:(term -> term -> prop), o:term. apply-functor X _ [] _ X. apply-functor X [ff,tt|Mask] [Y|YS] Rec R :- Rec Y Y1, apply-functor {coq.mk-app X [_,_,_,Y1]} Mask YS Rec R. apply-functor X [ff|Mask] [Y|YS] Rec R :- reali Y PY, apply-functor {coq.mk-app X [Y,PY]} Mask YS Rec R. %--------------------------------------------------------------------------- pred mk-reali i:term, o:term. mk-reali T R :- reali T R, !. mk-reali T _ :- Msg is "derive.eqbcorrect: no unary parametricity translation for " ^ {coq.term->string T} ^ ", use derive.param1 first", stop Msg. pred mk-eqb-for i:term, o:term. mk-eqb-for T R :- eqb-for T T R, !. mk-eqb-for T _ :- Msg is "derive.eqbcorrect: missing boolean equality for " ^ {coq.term->string T} ^ ", maybe use derive.eqb first", stop Msg. } coq-elpi-1.19.3/apps/derive/elpi/eqcorrect.elpi000066400000000000000000000114341451177652200213470ustar00rootroot00000000000000/* Correctness of comparison functions */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{map, rev, assert!, do!, appendR}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % link param1-functor-db and eqcorrect-db pred pointfree i:(term -> term -> term -> prop), i:term, i:term, o:term. pointfree F A B R :- coq.safe-dest-app A HDA ARGSA, coq.safe-dest-app B HDB ARGSB, appendR AA [_] ARGSA, appendR BB [_] ARGSB, coq.mk-app HDA AA LEFT, coq.mk-app HDB BB RIGHT, !, if (LEFT = RIGHT) (R = {{ fun _ x => x }}) (F LEFT RIGHT R). param1-functor-db {{ lib:elpi.derive.eq_axiom_at lp:A lp:F }} {{ lib:elpi.derive.eq_axiom_at lp:_ lp:F }} {{ fun (x : lp:A) (px : lib:elpi.derive.eq_axiom_at lp:A lp:F x) => px }}. param1-functor-db HypTy {{ lib:elpi.derive.eq_axiom_at lp:A lp:_ }} {{ fun (x : lp:A) (px : lp:(PA x)) => lp:(R x px) }} :- (pi x\ coq.mk-app HypTy [x] (PA x)), coq.safe-dest-app HypTy (global (indt KR)) Args, realiR (global KGR) (global (indt KR)), !, Msg is "derive.eqcorrect: no eqcorrect for " ^ {coq.gref->string KGR}, assert! (eqcorrect-db KGR OK) Msg, (derive.eqcorrect.mk-app-eqfun OK Args OKLemma), coq.typecheck OKLemma OKLemmaTy ok, % we do the HO inference of P in elpi, since Coq is unable to do it OKLemmaTy = (prod _ _ x\ prod _ (P x) _), (pi x\ pointfree param1-functor-db {coq.mk-app HypTy [x]} (P x) Map), pi x px\ coq.mk-app OKLemma [x,{coq.mk-app Map [x,px]}] (R x px). namespace derive.eqcorrect { pred mk-app-eqfun i:term, i:list term, o:term. mk-app-eqfun X [] X. mk-app-eqfun X [Y] R :- coq.mk-app X [Y] R. mk-app-eqfun X [Y,_|YS] R :- eq-db Y Y F, !, coq.mk-app X [Y,F] X1, mk-app-eqfun X1 YS R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % pred branch i:term, i:term, i:term, o:term. branch (prod N T x\ prod M (P x) (B x)) (prod _ _ y\ prod _ (Q y) (Lty y)) L (fun N T x\ fun M (P x) (R x)) :- !, @pi-decl `x` T x\ @pi-decl `px` (P x) px\ sigma Proof ProofXPX\ (pointfree param1-functor-db (P x) (Q x) Proof, coq.mk-app Proof [x,px] ProofXPX, branch (B x px) (Lty x ProofXPX) {coq.mk-app L [x,ProofXPX]} (R x px)). branch _ _ X X. pred branches i:list term, i:term, o:list term. branches [] _ []. branches [Lemma | Lemmas] (prod _ S T) [P|PS] :- coq.typecheck Lemma LemmaTy ok, branch S LemmaTy Lemma P, branches Lemmas (T P) PS. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % apply the induction principle to the P and the fill in all branches % using eqK lemmas pred eqK-lem i:list term, i:term, o:term. eqK-lem Args K Lemma :- coq.safe-dest-app K (global (indc Kname)) _, eqK-db Kname Lem, coq.mk-app Lem Args Lemma. pred idx i:term, i:term, i:list term, i:term, i:list term, o:term. idx (sort _) IT K IndP A R :- !, eq-db IT IT Cmp, !, coq.mk-app IndP [ {{ lib:elpi.derive.eq_axiom_at lp:IT lp:Cmp }} ] Induction, coq.typecheck Induction Inductionty ok, branches {map K (eqK-lem A)} Inductionty KArgs, coq.mk-app Induction KArgs R. idx Arity IT K IndP A R :- whd1 Arity Arity1, !, idx Arity1 IT K IndP A R. idx _ _ _ _ _ _ :- assert! false "derive.eqcorrect: indexed data not supported". %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Input paremeters and their equality tests pred params i:int, i:term, i:term, i:list term, i:term, i:list term, o:term. params L (prod N S T) I K IndP A R :- L > 0, !, M is L - 1, R = {{ fun (a : lp:S) (fa : a -> a -> bool) => lp:(Bo a fa) }}, @pi-decl N S a\ @pi-decl `fa` {{ lp:a -> lp:a -> bool }} fa\ (eq-db a a fa :- !) => params M (T a) {coq.mk-app I [a]} {map K (x\ coq.mk-app x [a])} {coq.mk-app IndP [a, {{ lib:elpi.derive.eq_axiom_at lp:a lp:fa }}]} [fa,a|A] (Bo a fa). params 0 Arity T K IndP A R :- idx Arity T K IndP {rev A} R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred main i:inductive, i:string, o:list prop. main GR Name [C] :- do! [ T = global (indt GR), assert! (induction-db GR IndP) "derive.eqcorrect: use derive.induction first", coq.env.indt GR Ind Lno _ Arity K _KT, assert! (Ind = tt) "derive.eqcorrect: co-inductive types not supported", % derive and define the lemma params Lno Arity T {std.map K (k\r\ r = global (indc k))} IndP [] CmpOK, std.assert-ok! (coq.typecheck CmpOK CmpTy) "derive.eqcorrect generates illtyped term", coq.env.add-const Name CmpOK CmpTy @opaque! Thm, % add a clause to the db C = (eqcorrect-db (indt GR) (global (const Thm)) :- !), coq.elpi.accumulate _ "derive.eqcorrect.db" (clause _ (before "eqcorrect-db:fail") C) ]. } coq-elpi-1.19.3/apps/derive/elpi/fields.elpi000066400000000000000000000304111451177652200206220ustar00rootroot00000000000000/* fields type description and accessor */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ macro @pi-trm N T F :- pi x xx\ decl x N T => (feqb.trm->term xx x :- !) => F xx x. namespace derive.fields { pred fields_t. % chose between fields_t and construct pred self o:term. pred std.stop-do! i:list prop. std.stop-do! []. std.stop-do! [P|PS] :- coq.say P, (pi x\ stop x :- !, fail) => P, !, std.stop-do! PS. std.stop-do! [P|_] :- coq.say "STOP" P. pred main i:inductive, i:string, o:list prop. main I Prefix AllCL :- std.do! [ std.assert! (tag-for I Tag) "no tag for this inductive, run that derivation first", std.assert! (eqType I FI) "this inductive is not supported", coq.env.indt I _ _ _ Arity KS _, box (global (indt I)) KS FI CLB, CLB => fields_t.main FI (global (indt I)) Body_t, std.assert-ok! (coq.typecheck Body_t Ty_t) "derive.fields generates illtyped fields_t", Name_t is Prefix ^ "fields_t", coq.ensure-fresh-global-id Name_t FName_t, coq.env.add-const FName_t Body_t Ty_t ff Fields_t, CLB => fields.main FI (global (indt I)) (global (const Fields_t)) (global (const Tag)) BodySkel, % we elaborate only for primitive records... std.assert-ok! (coq.elaborate-skeleton BodySkel Ty Body) "derive.fields generates illtyped fields", Name is Prefix ^ "fields", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName Body Ty ff Fields, CLB => construct.main FI (global (indt I)) Fields_t Body_c, std.assert-ok! (coq.typecheck Body_c Ty_c) "derive.fields generates illtyped construct", Name_c is Prefix ^ "construct", coq.ensure-fresh-global-id Name_c FName_c, coq.env.add-const FName_c Body_c Ty_c ff Construct, coq.bind-ind-arity (global (indt I)) Arity (case-refl Tag Fields Construct) Body_PSkel, std.assert-ok! (coq.elaborate-skeleton Body_PSkel Ty_P Body_P) "derive.fields generates illtyped constructP", Name_P is Prefix ^ "constructP", coq.ensure-fresh-global-id Name_P FName_P, coq.env.add-const FName_P Body_P Ty_P @opaque! ConstructP, AllCL = [fields-for I Fields_t Fields Construct ConstructP|CLB], std.forall AllCL (x\ coq.elpi.accumulate _ "derive.fields.db" (clause _ _ x)), ]. % ---------------------------------------------------------------------- pred fields_t.main i:eqType, i:term, o:term. fields_t.main (type-param F) I {{ fun p : Type => lp:(R p) }} :- !, @pi-trm `p` {{ Type }} x\p\ fields_t.main (F x) {coq.mk-app I [p]} (R p). fields_t.main (value-param TY F) I {{ fun p : lp:Ty => lp:(R p) }} :- !, feqb.trm->term TY Ty, @pi-trm `p` Ty x\p\ fields_t.main (F x) {coq.mk-app I [p]} (R p). fields_t.main (inductive _ F) I {{ fun p : lib:elpi.derive.positive => lp:(R p) }} :- coq.safe-dest-app I _ Params, @pi-decl `p` {{ lib:elpi.derive.positive }} p\ pi i\ splay-over-positive p (F i) fields_t.rty {{ unit }} (fields_t.k Params) (R p). pred fields_t.rty i:term, o:term. fields_t.rty _ {{ Type }}. pred fields_t.k i:list term, i:constructor, o:term. fields_t.k Params (constructor K _) T :- box-for K I _, coq.mk-app (global (indt I)) Params T. % ---------------------------------------------------------------------- pred fields.main i:eqType, i:term, i:term, i:term, o:term. fields.main (type-param F) I F_t Tag {{ fun p : Type => lp:(R p) }} :- !, @pi-trm `p` {{ Type }} x\p\ fields.main (F x) {coq.mk-app I [p]} {coq.mk-app F_t [p]} {coq.mk-app Tag [p]} (R p). fields.main (value-param TY F) I F_t Tag {{ fun p : lp:Ty => lp:(R p) }} :- !, feqb.trm->term TY Ty, @pi-trm `p` Ty x\p\ fields.main (F x) {coq.mk-app I [p]} {coq.mk-app F_t [p]} {coq.mk-app Tag [p]} (R p). fields.main (inductive _ _) I F_t Tag {{ fun i : lp:I => lp:(R i) }} :- @pi-trm `i` I _\i\ coq.build-match i I (fields.rty F_t Tag) fields.branch (R i). pred fields.rty i:term, i:term, i:term, i:list term, i:list term, o:term. fields.rty F_t Tag _ Vars _ {{ lp:F_t (lp:Tag lp:X) }} :- std.last Vars X. pred fields.branch i:term, i:term, i:list term, i:list term, o:term. fields.branch K _ Vars _ R :- coq.safe-dest-app K (global (indc C)) Params, box-for C _ B, coq.mk-app (global (indc B)) {std.append Params Vars} R. % ------------------------------------------------------------------------ pred box i:term, i:list constructor, i:eqType, o:list prop. box I KL Decl CL :- std.do! [ box.aux Decl I ILDr, box.declare KL ILDr CL, ]. pred box.declare i:list constructor, i:list box-spec, o:list prop. box.declare [] [] []. box.declare [K|Ks] [real-box I|Bs] [C|Cs] :- std.assert-ok! (coq.elaborate-indt-decl-skeleton I D) "ILD", coq.env.add-indt D IB, coq.env.indt IB _ _ _ _ [KB] _, C = box-for K IB KB, C => box.declare Ks Bs Cs. box.declare [K|Ks] [same-box K1|Bs] [box-for K IB KB|Cs] :- box-for K1 IB KB, box.declare Ks Bs Cs. kind box-spec type. type real-box indt-decl -> box-spec. type same-box constructor -> box-spec. pred box.aux i:eqType, i:term, o:list box-spec. box.aux (type-param F) I L :- (@pi-trm `p` {{ Type }} x\y\ box.aux (F x) {coq.mk-app I [y]} (L1 y)), distribute L1 (f\r\ sigma U\ r = parameter "A" explicit (sort (typ U)) f) L. box.aux (value-param TY F) I L :- feqb.trm->term TY Ty, (@pi-trm `p` Ty x\y\ box.aux (F x) {coq.mk-app I [y]} (L1 y)), distribute L1 (f\r\ r = parameter "v" explicit Ty f) L. box.aux (inductive Ind F) I L :- pi x\ box.aux2 I Ind x (F x) L. pred args-of o:constructor, o:arguments. box.aux2 _ _ _ [] []. box.aux2 I Ind X [constructor _ Args|MoreKs] [same-box K|MoreBoxes] :- args-of K Args, !, box.aux2 I Ind X MoreKs MoreBoxes. box.aux2 I Ind X [constructor K Args|MoreKs] [real-box (record ID1 S ID2 Fields)|MoreBoxes] :- if (coq.env.informative? Ind) (S = {{ Type }}) (S = {{ Prop }}), ID1 is "box_" ^ {coq.gref->id (indt Ind)} ^ "_" ^ {coq.gref->id (indc K)}, ID2 is "Box_" ^ {coq.gref->id (indt Ind)} ^ "_" ^ {coq.gref->id (indc K)}, (feqb.trm->term X I :- !) => box.box-argument ID2 0 Args Fields, args-of K Args => box.aux2 I Ind X MoreKs MoreBoxes. pred box.box-argument i:string, i:int, i:arguments, o:record-decl. box.box-argument _ _ (stop _) end-record. box.box-argument S M (regular T Args) (field [] N TY _\A) :- N is S ^ "_" ^ {std.any->string M}, feqb.trm->term T TY, box.box-argument S {calc (M + 1)} Args A. box.box-argument S M (irrelevant T Args) (field [] N TY _\A) :- N is S ^ "_" ^ {std.any->string M}, feqb.trm->term T TY, box.box-argument S {calc (M + 1)} Args A. box.box-argument S M (dependent T Args) (field [] N TY A) :- N is S ^ "_" ^ {std.any->string M}, feqb.trm->term T TY, pi x y\ (feqb.trm->term x y :- !) => box.box-argument S {calc (M + 1)} (Args x) (A y). pred distribute i:(A -> list box-spec), i:((A -> indt-decl) -> indt-decl -> prop), o:list box-spec. distribute (_\ []) _ []. distribute (x\ [real-box (X x)| XS x]) F [real-box F_X|R] :- F X F_X, distribute XS F R. distribute (x\ [same-box K| XS x]) F [same-box K|R] :- distribute XS F R. % ---------------------------------------------------------------------- pred construct.main i:eqType, i:term, i:constant, o:term. construct.main (type-param F) I F_t {{ fun p : Type => lp:(R p) }} :- @pi-trm `p` {{ Type }} x\p\ construct.main (F x) {coq.mk-app I [p]} F_t (R p). construct.main (value-param TY F) I F_t {{ fun p : lp:Ty => lp:(R p) }} :- feqb.trm->term TY Ty, @pi-trm `p` Ty x\p\ construct.main (F x) {coq.mk-app I [p]} F_t (R p). construct.main (inductive _ F) I F_t {{ fun p : lib:elpi.derive.positive => lp:(R p) }} :- coq.safe-dest-app I _ Params, coq.mk-app (global (const F_t)) Params Fields_t, @pi-decl `p` {{ lib:elpi.derive.positive }} p\ pi i\ splay-over-positive p (F i) (construct.rty1 Fields_t I) {{ fun (_:lib:elpi.derive.unit) => @None lp:I }} (construct.k I Params) (R p). pred construct.rty1 i:term, i:term, i:term, o:term. construct.rty1 Fields_t I X {{ lp:Fields_t lp:X -> option lp:I }}. pred construct.k i:term, i:list term, i:constructor, o:term. construct.k _ Params (constructor K (stop _)) {{ fun b : lp:BoxTy => Some lp:B }} :- !, box-for K BT _, coq.mk-app (global (indt BT)) Params BoxTy, coq.mk-app (global (indc K)) Params B. construct.k I Params (constructor K _) {{ fun b : lp:BoxTy => lp:(R b) }} :- box-for K BT _, coq.mk-app (global (indt BT)) Params BoxTy, @pi-decl `b` BoxTy b\ coq.build-match b BoxTy (construct.rty I) (construct.branch {coq.mk-app (global (indc K)) Params}) (R b). pred construct.rty i:term, i:term, i:list term, i:list term, o:term. construct.rty I _ _ _ {{ option lp:I }}. pred construct.branch i:term, i:term, i:term, i:list term, i:list term, o:term. construct.branch B _ _ Vars _ {{ Some lp:BVars }} :- coq.mk-app B Vars BVars. % ------------------------------------------------------------------------- % match x return construct (fields x) = Some x with _ => erefl pred case-refl i:constant, i:constant, i:constant, i:term, i:list term, i:list term, o:term. case-refl Tag Fields Construct _ ParamsX Tys R :- std.appendR Params [X] ParamsX, coq.mk-app (global (const Tag)) Params TP, coq.mk-app (global (const Fields)) Params FP, coq.mk-app (global (const Construct)) Params CP, coq.build-match X {std.last Tys} (case-refl-rty TP FP CP) case-refl-branch R. pred case-refl-rty i:term, i:term, i:term, i:term, i:list term,i:list term, o:term. case-refl-rty Tag Fields Construct _ Vs _ {{ lp:Construct (lp:Tag lp:X) (lp:Fields lp:X) = Some lp:X }} :- std.last Vs X. pred case-refl-branch i:term, i:term, i:list term,i:list term, o:term. case-refl-branch _ _ _ _ {{ refl_equal }}. pred splay-over-positive i:term, i:list A, i:(term -> term -> prop), i:term, i:(A -> term -> prop), o:term. splay-over-positive X L DoRty Def DoBranch R :- splay-over-positive.aux X (x\x) L DoRty DoBranch Def R. pred splay-over-positive.aux i:term, i:(term -> term), i:list A, i:(term -> term -> prop), i:(A -> term -> prop), i:term, o:term. splay-over-positive.aux _ _ [] _ _ Def Def :- !. splay-over-positive.aux _ _ [X] _ DoBranch _ R :- DoBranch X R, !. splay-over-positive.aux X XCtx KL DoRty DoBranch Def R :- coq.build-match X {{ lib:elpi.derive.positive }} (do-rty XCtx DoRty) (do-branch XCtx DoRty DoBranch Def KL) R. pred do-rty i:(term -> term), i:(term -> term -> prop), i:term, i:list term,i:list term, o:term. do-rty Ctx DoRty _ Vs _ R :- P = Ctx {std.last Vs}, DoRty P R. pred list-bitmask i:list A, o:list A, o:list A. list-bitmask [] [] []. list-bitmask [X] [X] []. list-bitmask [X,Y|L] [X|A] [Y|B] :- list-bitmask L A B. pred do-branch i:(term -> term), i:(term -> term -> prop), i:(A -> term -> prop), i:term, i:list A, i:term, i:term, i:list term, i:list term, o:term. do-branch PCtx DoRty DoBranch Def [_|KS] {{ xO }} _ [P] _ R :- !, list-bitmask KS KODD _, splay-over-positive.aux P (x\ PCtx {{ xO lp:x }}) KODD DoRty DoBranch Def R. do-branch PCtx DoRty DoBranch Def [_|KS] {{ xI }} _ [P] _ R :- !, list-bitmask KS _ KEVEN, splay-over-positive.aux P (x\ PCtx {{ xI lp:x }}) KEVEN DoRty DoBranch Def R. do-branch _ _ DoBranch _ [X|_] {{ xH }} _ _ _ R :- DoBranch X R, !. pred prod->tuple i:term, o:term. prod->tuple (prod N Ty F) {{ { x:lp:Ty & lp:(X x)}%type }} :- /*(F = x\prod _ _ _),*/ (pi x\ occurs x (F x)), !, % not the last one and dependent @pi-decl N Ty x\ prod->tuple (F x) (X x). prod->tuple (prod N Ty F) {{ (lp:Ty * lp:X)%type }} :- /*(F = x\prod _ _ _),*/ !, % not the last one @pi-decl N Ty x\ prod->tuple (F x) X. prod->tuple (prod _ Ty _) Ty. prod->tuple _ {{ unit }}. % other branches pred repack-as-tuple i:constant, i:constant, i:term, i:list term, i:list term, o:term. repack-as-tuple C_t Tag _ Vars Tys R :- std.appendR Params [X] Vars, std.last Tys XTy, coq.mk-app (global (const C_t)) Params C_tp, coq.mk-app (global (const Tag)) Params Tagp, coq.build-match X XTy (do-rty_t C_tp Tagp) args->tuple R. pred do-rty_t i:term, i:term, i:term, i:list term,i:list term, o:term. do-rty_t C_t Tag _ Vars _ {{ lp:C_t (lp:Tag lp:X) }} :- std.last Vars X. pred args->tuple i:term, i:term, i:list term, i:list term, o:term. args->tuple _ _ [] _ {{ tt }}. /*args->tuple _ _ [X] _ X.*/ args->tuple A B [X|XS] [T|TS] {{ @existT lp:T _ lp:X lp:R }} :- occurs X TS, !, args->tuple A B XS TS R. args->tuple A B [X|XS] [_T|TS] {{ ( lp:X , lp:R ) }} :- args->tuple A B XS TS R. }coq-elpi-1.19.3/apps/derive/elpi/idx2inv.elpi000066400000000000000000000064361451177652200207510ustar00rootroot00000000000000/* Links an inductive an its inverted form */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{last, assert!, do!}. namespace derive.idx2inv { pred params i:indt-decl, i:term, i:term, o:term. params (parameter ID _ Ty In) T Ti (fun Name Ty Out) :- coq.id->name ID Name, @pi-decl Name Ty p\ params (In p) {coq.mk-app T [p]} {coq.mk-app Ti [p]} (Out p). params (inductive _ _ Arity _) T Ti (fix `rec` N FixTy FixBo) :- coq.safe-dest-app T (global (indt GR)) _, coq.env.recursive? GR, !, coq.arity->term Arity Ty, compute-fix-ty Ty T Ti N FixTy, compute-fix-clause Ty T Ti N Prove, compute-fix-clause Ty T Ti {calc (N + 1)} Prove1, @pi-decl `rec` Ty f\ Prove f => Prove1 f => compute-fix-bo Ty T Ti (FixBo f). params (inductive _ _ Arity _) T Ti Bo :- coq.arity->term Arity Ty, compute-fix-bo Ty T Ti Bo. pred compute-fix-ty i:term, i:term, i:term, o:int, o:term. compute-fix-ty (prod N S Tgt) T Ti M (prod N S T1) :- !, @pi-decl N S x\ compute-fix-ty (Tgt x) {coq.mk-app T [x]} {coq.mk-app Ti [x]} J (T1 x), M is J + 1. compute-fix-ty _ S T 0 {{ lp:S -> lp:T }}. pred compute-fix-clause i:term, i:term, i:term, i:int, o:(term -> prop). compute-fix-clause _ S T 1 (ih\ param1-functor-db S T ih). compute-fix-clause (prod N S Tgt) T Ti M (ih\ pi x\ C ih x) :- !, J is M - 1, @pi-decl N S x\ compute-fix-clause (Tgt x) {coq.mk-app T [x]} {coq.mk-app Ti [x]} J (ih\ C ih x). pred compute-fix-bo i:term, i:term, i:term, o:term. compute-fix-bo (prod N S Tgt) T Ti (fun N S T1) :- !, @pi-decl N S x\ compute-fix-bo (Tgt x) {coq.mk-app T [x]} Ti (T1 x). compute-fix-bo _ T Ti (fun `x` T B) :- @pi-decl `x` T x\ coq.build-match x T (mk-rty Ti) (mk-branch) (B x). pred mk-rty i:term, i:term, i:list term, i:list term, o:term. mk-rty Ti _ Vars _ R :- std.appendR Idxs [_] Vars, coq.mk-app Ti Idxs R. pred mk-branch i:term, i:term, i:list term, i:list term, o:term. mk-branch K KTy Vars VarsTy R :- std.do! [ coq.safe-dest-app K (global (indc GR)) _, coq.safe-dest-app KTy (global (indt I)) IArgs, coq.env.indt I _ _ NP _ _ _, std.split-at NP IArgs Params IDX, Vars = RealArgs, VarsTy = RealArgsTy, assert! (invert-db (indc GR) InvK) "derive.idx2inv: No inverted constructor", coq.mk-app {coq.mk-app (global InvK) Params} IDX K1, (pi H G P\ paramX.prove H G P :- param1-functor-db H G P) => (pi X T\ paramX.cross T :- (pi M\stop M :- !, fail) => realiR X T) => paramX.prove-args RealArgs RealArgsTy Args, coq.mk-app K1 Args K2, std.map IDX mk-refl ArgsEq, coq.mk-app K2 ArgsEq R, ]. pred mk-refl i:term, o:term. mk-refl E {{ @refl_equal _ lp:E }}. pred main i:inductive, i:string, o:list prop. main GR Infix [Clause] :- do! [ T = global (indt GR), assert! (invert-db (indt GR) (indt GRinv)) "derive.idx2inv: No inverted inductive", Tinv = global (indt GRinv), Name is {coq.gref->id (indt GR)} ^ Infix ^ {coq.gref->id (indt GRinv)}, coq.env.indt-decl GR D, copy T Tinv => params D T Tinv R, std.assert-ok! (coq.typecheck R RT) "derive.idx2inv: illtyped term", coq.env.add-const Name R RT _ C, Clause = idx2inv-db GR GRinv C C, coq.elpi.accumulate _ "derive.idx2inv.db" (clause _ _ Clause) ]. } % vim: set spelllang=: coq-elpi-1.19.3/apps/derive/elpi/induction.elpi000066400000000000000000000123431451177652200213540ustar00rootroot00000000000000/* induction principles */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{do!, assert!, last, appendR, rev, map}. namespace derive.induction { % local db associating to each constructor the hypothesis to be used type induction-hyp-db term -> term -> prop. pred informative. % loaded in the context if we can elim to Type % create (paramX.prove (is_T params) P IH) pred mk-paramX.prove-clause i:list term, i:term, i:term, i:term, o:prop. mk-paramX.prove-clause [_] T P IH (param1-functor-db T P IH). mk-paramX.prove-clause [_,_|Args] T P IH (pi x y\ C x y) :- pi x y\ mk-paramX.prove-clause Args {coq.mk-app T [x,y]} {coq.mk-app P [x,y]} {coq.mk-app IH [x,y]} (C x y). % branch for constructor k is (hyp-k ...) where ... are the terms % generated by prove-args pred branch i:term, i:term, i:list term, i:list term, o:term. branch K _ V VT R :- induction-hyp-db K IH, (pi H G P\ paramX.prove H G P :- param1-functor-db H G P) => (pi X\ paramX.cross X) => paramX.prove-args V VT Args, coq.mk-app IH Args R. pred oty i:term, i:list term, i:list term, o:term. oty _ _ VT P :- last VT XT, copy XT P. pred branches i:term, i:term, i:list term, i:term, i:int, o:int, o:term, o:term. branches (prod Name S T) Ity Args IH N M (prod Name S F1) (fun Name S R1) :- !, @pi-decl Name S x\ branches (T x) Ity [x|Args] IH {calc (N + 1)} M (F1 x) (R1 x). branches (sort _) Ity Args IH Rno Rno Fty (fun `x` ItyArgs Bo) :- do! [ coq.mk-app Ity {rev Args} ItyArgs, copy ItyArgs PArgs, Fty = prod `x` ItyArgs (_\ PArgs), copy Ity P, mk-paramX.prove-clause Args Ity P IH C, @pi-decl `x` ItyArgs x\ C => coq.build-match x ItyArgs oty branch (Bo x) ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Synthesize the type of each hypothesis starting from the type % of the constructor of is_T pred hyp i:term, o:term. hyp (prod N S T) (prod N Q R) :- !, copy S Q, @pi-decl N Q x\ hyp (T x) (R x). hyp S Q :- copy S Q. pred hyps i:list term, i:list term, i:term, i:term, o:term. hyps [K|KS] [KT|KTS] Ity Arity (fun Name Ind Bo) :- coq.term->gref K GRK, coq.name-suffix `H` {coq.gref->id GRK} Name, hyp KT Ind, !, % we cut since copy generates many solutions @pi-decl `Name` Ind x\ induction-hyp-db K x => % This is the hyp to be used for branch K hyps KS KTS Ity Arity (Bo x). hyps [] [] Ity Arity (fix `IH` Recno Fty Bo) :- @pi-decl `IH` Fty f\ sigma C\ branches Arity Ity [] f 0 Recno Fty (Bo f). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Parameters and the P of the induction predicate (truncated wrt the type % of the unary parametricity translation, eg P takes only the indexes) pred truncated-predicate-ty i:term, o:term. truncated-predicate-ty (sort _) T :- informative, !, T = sort (typ U), coq.univ.new U. truncated-predicate-ty (sort _) (sort prop). truncated-predicate-ty (prod N S T) (prod N S R) :- @pi-decl N S x\ truncated-predicate-ty (T x) (R x). % loads the context with the substitution "is_T params -> P" pred mk-subst-clause i:term, i:term, o:list prop. mk-subst-clause Ity P C :- coq.safe-dest-app Ity IT ITArgs, C = [(copy IT P :- !), (pi Args Rest O\ copy (app[IT|Args]) O :- !, appendR ITArgs Rest Args, coq.mk-app P Rest O)]. pred params i:int, i:term, i:list term, i:list term, i:term, o:term. params N Ity K KT (prod Nx Sx x\ prod NP (SP x) (T x)) (fun Nx Sx x\ fun NP (SP x) (R1 x)) :- N > 0, !, M is N - 2, @pi-decl Nx Sx x\ @pi-decl NP (SP x) px\ % useless, the identity map is already there % paramX.prove px px (fun `x` x a\ fun `pa` (app[px,a]) pa\ pa) => params M {coq.mk-app Ity [x,px]} {map K (k\ coq.mk-app k [x,px])} {map KT (coq.subst-prod [x,px])} (T x px) (R1 x px). params 0 Ity K KT Arity (fun `P` Pty p\ Bo p) :- % P only takes the indexes of Arity truncated-predicate-ty Arity Pty, @pi-decl `P` Pty p\ sigma Subst\ (mk-subst-clause Ity p Subst, % replace (is_T params) with P Subst => hyps K KT Ity Arity (Bo p)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred main i:inductive, i:string, o:list prop. main GR Prefix [Clause] :- do! [ T = global (indt GR), if (coq.env.informative? GR) (Informative = [informative]) (Informative = []), assert! (reali T TR) {calc ( "derive.induction: no unary parametricity translation for" ^ {coq.term->string T} ^ ", use derive.param1 first")}, TR = global (indt GRR), coq.env.indt GRR Ind Lno _ Arity K KT, assert! (Ind = tt) "derive.induction: Coinductive types are not supported", % we build the induction principle Informative => params Lno TR {std.map K (k\r\ r = global (indc k))} KT Arity R, % coq.say {coq.term->string R}, std.assert-ok! (coq.typecheck R RT) "derive.induction generates illtyped term", Name is Prefix ^ "induction", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R RT _ I, % we register it as a clause Clause = (induction-db GR (global (const I)) :- !), coq.elpi.accumulate _ "derive.induction.db" (clause _ (before "induction-db:fail") Clause) ]. } coq-elpi-1.19.3/apps/derive/elpi/injection.elpi000066400000000000000000000040071451177652200213400ustar00rootroot00000000000000/* core of injection */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{append, drop, length, do!}. namespace ltac.injection { pred arg-i i:int, i:int, i:term, i:inductive, i:list term, i:int, i:constructor, i:list term, i:term, i:term, i:term, o:list term. arg-i MAX MAX _ _ _ _ _ _ _ _ _ [] :- !. arg-i J MAX EQF GR TyArgs Pno GRK KArgs A B H R :- J < MAX, I is J + 1, if (projK-db GRK I Proj) (do! [ drop Pno KArgs Defaults, coq.mk-app Proj {append TyArgs Defaults} Projector, coq.mk-app (global (indt GR)) TyArgs Ty, coq.typecheck Projector (prod _ _ _\Ty2) ok, % FIXME whd coq.mk-app EQF [Ty,Ty2,Projector,A,B,H] P, R = [P|RS] ]) (R = RS), arg-i I MAX EQF GR TyArgs Pno GRK KArgs A B H RS. } namespace ltac { % Tests if the command can be applied pred injection? i:term, o:inductive, o:list term, o:constructor, o:list term, o:term, o:term. injection? Ty GR TyArgs GRK KArgs A B :- do! [ whd Ty [] {{lib:@elpi.eq}} [T,A,B], whd T [] (global (indt GR)) TyArgs, whd A [] (global (indc GRK)) KArgs, whd B [] (global (indc GRB)) _, GRK = GRB ]. % Does the job pred injection! i:term, o:list term, i:inductive, i:list term, i:constructor, i:list term, i:term, i:term. injection! H PL GR TyArgs GRK KArgs A B :- do! [ coq.env.indt GR _ Pno _ _ _ _, length KArgs Argsno, Eqno is Argsno - Pno, ltac.injection.arg-i 0 Eqno {{lib:@elpi.derive.eq_f}} GR TyArgs Pno GRK KArgs A B H PL ]. % Main entry point with assertion that H can be injected pred injection i:term, i:term, i:term, o:list term. injection H EqAB _ PL :- if (injection? EqAB GR TyArgs GRK KArgs A B) (injection! H PL GR TyArgs GRK KArgs A B) (coq.error "injection:" {coq.term->string H} "of type" {coq.term->string EqAB} "does not equate equal constructors"). } % vim:set ft=lprolog spelllang=: coq-elpi-1.19.3/apps/derive/elpi/invert.elpi000066400000000000000000000071061451177652200206700ustar00rootroot00000000000000/* Hide indexes using non-uniform parameters */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, map-i, map}. namespace derive.invert { pred the-inductive i:term, o:int. pred the-nup-for-idx i:int, o:term. pred the-suffix o:string. pred invert i:indt-decl, o:indt-decl. invert (parameter ID Imp Ty In) (parameter ID Imp Ty Out) :- @pi-parameter ID Ty p\ invert (In p) (Out p). invert (inductive ID IsInd Arity Ks) (inductive ID1 IsInd Arity1 Ks1) :- ID1 is ID ^ {the-suffix}, coq.arity->nparams Arity Nup, trivial-arity Arity 0 Arity1, coq.arity->term Arity ITy, @pi-parameter ID ITy i\ the-inductive i Nup => std.map (Ks i) (invert-c Nup Arity1) (Ks1 i). pred invert-c i:int, i:arity, i:indc-decl, o:indc-decl. invert-c Nup ArityI (constructor ID ArityK) (constructor ID1 ArityK1) :- ID1 is ID ^ {the-suffix}, invert-c-params Nup ArityI ArityK ArityK1. pred invert-c-params i:int, i:arity, i:arity, o:arity. invert-c-params Nup (parameter ID Imp Ty In) (parameter _ _ _ In1) (parameter ID Imp Ty Out):- Nup > 0, Nup1 is Nup - 1, @pi-parameter ID Ty p\ invert-c-params Nup1 (In p) (In1 p) (Out p). invert-c-params 0 Arity KArity Out :- invert-c-params-idx 0 Arity KArity Out. pred invert-c-params-idx i:int, i:arity, i:arity, o:arity. invert-c-params-idx Idx (parameter ID Imp Ty In) KArity (parameter ID Imp Ty Out) :- Idx1 is Idx + 1, @pi-parameter ID Ty p\ the-nup-for-idx Idx p => invert-c-params-idx Idx1 (In p) KArity (Out p). invert-c-params-idx _ (arity _) KArity KArity1 :- invert-c-arity KArity KArity1. pred invert-c-arity i:arity, o:arity. invert-c-arity (parameter ID Imp Ty In) (parameter ID Imp Ty Out) :- @pi-parameter ID Ty p\ invert-c-arity (In p) (Out p). invert-c-arity (arity T) (arity T1) :- invert-c-ty T T1. pred invert-c-ty i:term, o:term. invert-c-ty (prod N S T) (prod N S T1) :- !, @pi-decl N S x\ invert-c-ty (T x) (T1 x). invert-c-ty I I :- the-inductive I _, !. invert-c-ty (app[I|Args]) Out :- the-inductive I Nup, !, std.split-at Nup Args NUArgs Indexes, invert-c-ty-eq Indexes 0 (app[I|NUArgs]) Out. pred invert-c-ty-eq i:list term, i:int, i:term, o:term. invert-c-ty-eq [] _ X X. invert-c-ty-eq [I|Idxs] N Acc {{ lp:V = lp:I -> lp:Out }} :- std.assert! (the-nup-for-idx N V) "no variable to equate to index expression", M is N + 1, invert-c-ty-eq Idxs M {coq.mk-app Acc [V]} Out. pred trivial-arity i:arity, i:int, o:arity. trivial-arity (parameter ID Imp Ty In) Ni (parameter ID Imp Ty Out) :- @pi-parameter ID Ty p\ trivial-arity (In p) Ni (Out p). trivial-arity (arity (prod Name Ty In)) Ni (parameter ID explicit Ty Out) :- ID is "idx" ^ {term_to_string Ni}, Ni1 is Ni + 1, @pi-decl Name Ty p\ trivial-arity (arity (In p)) Ni1 (Out p). trivial-arity (arity T) _ (arity T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred main i:inductive, i:string, o:list prop. main GR Suffix Clauses :- do! [ coq.env.indt-decl GR Decl, the-suffix Suffix => invert Decl Decl1, std.assert-ok! (coq.typecheck-indt-decl Decl1) "derive.invert generates illtyped term", coq.env.add-indt Decl1 Inv, coq.env.indt GR _ _ _ _ Ks _, coq.env.indt Inv _ _ _ _ KIs _, Clauses = [invert-db (indt GR) (indt Inv) | {std.map2 Ks KIs mk-k-clause}], std.forall Clauses (c\coq.elpi.accumulate _ "derive.invert.db" (clause _ _ c)) ]. pred mk-k-clause i:constructor, i:constructor, o:prop. mk-k-clause K1 K2 (invert-db (indc K1) (indc K2)). } % vim: set spelllang=: coq-elpi-1.19.3/apps/derive/elpi/isK.elpi000066400000000000000000000030371451177652200201060ustar00rootroot00000000000000/* Derive a function "isK t -> true" iif t is "K .." for K constructor */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, last, forall, map}. namespace derive.isK { pred ty i:term, i:list term, i:list term, o:term. ty _ _ _ {{ bool }}. % if the branch of the match (corresponding to KParams) is the one % for K (the constructor we are generating the isK function for) we say % true, else we say false. pred branch i:term, i:term, i:term, i:list term, i:list term, o:term. branch K KParams _ _ _ {{ true }} :- coq.safe-dest-app KParams K _, !. branch _ _ _ _ _ {{ false }}. pred body i:term, i:term, i:list term, i:list term, o:term. body K _ Vars Tys R :- last Vars X, last Tys TX, coq.build-match X TX ty (branch K) R. pred main-K i:string, i:term, i:term, i:constructor, o:prop. main-K Prefix Ity Arity GRK Clause :- K = (global (indc GRK)), coq.bind-ind-arity Ity Arity (body K) TSek, std.assert-ok! (coq.elaborate-skeleton TSek Ty T) "derive.isK generates illtyped term", Name is Prefix ^ {coq.gref->id (indc GRK)}, coq.env.add-const Name T Ty _ IsK, Clause = (isK-db GRK (global (const IsK)) :- !). pred main i:inductive, i:string, i:list prop. main GR Prefix Clauses :- T = global (indt GR), coq.env.indt GR _ _ _ Arity Kn _, map Kn (main-K Prefix T Arity) Clauses, forall Clauses (c\ coq.elpi.accumulate _ "derive.isK.db" (clause _ (before "isK-db:fail") c)). } % vim: set spelllang=: coq-elpi-1.19.3/apps/derive/elpi/lens.elpi000066400000000000000000000067151451177652200203270ustar00rootroot00000000000000/* A lens, to see better */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive.lens { pred build-lens i:record-decl, i:int, i:term, o:list id, o:list term. build-lens end-record _ _ [] []. build-lens (field _ ID Ty Fields) N RTy [ID|IDL] [Lens|BOL] :- if (pi x\ occurs x (Fields x)) (stop "derive.lens: dependent records not supported") true, View = {{ fun (r : lp:RTy) => lp:{{ % Coq term {coq.build-match {{r}} RTy (constant-rty Ty) (build-view N)} % Elpi "function" to build a match, see coq-lib.elpi }} }}, % we let Coq infer the type of f at type checking time Over = {{ fun f (r : lp:RTy) => lp:{{ {coq.build-match {{r}} RTy (constant-rty RTy) (build-over N {{f}})} }} }}, Lens = {{ lib:@elpi.derive.lens.make _ _ _ _ lp:View lp:Over }}, M is N + 1, Dummy = sort prop, build-lens (Fields Dummy) M RTy IDL BOL. % builds the return type of the match pred constant-rty i:term, i:term, i:list term, i:list term, o:term. constant-rty X _ _ _ X. % builds the match branch for view, L is the list of arguments to % the record constructor pred build-view i:int, i:term, i:term, i:list term, i:list term, o:term. build-view N _ _ L _ R :- std.nth N L R. % builds the match branch for over, K is the record constructor (already % applied) to the record parameters pred build-over i:int, i:term, i:term, i:term, i:list term, i:list term, o:term. build-over N F K _ L _ R :- std.split-at N L Before [X|After], coq.mk-app K {std.append Before [{{ lp:F lp:X }}|After]} R. % moves under the paramters of the inductive type type and binds them back % as a lambd abstraction over all the lenses that were built pred params i:indt-decl, i:term, o:list id, o:list term. params (parameter ID _ Ty Decl) RTy IL TL :- coq.id->name ID Name, (@pi-decl Name Ty x\ params (Decl x) {coq.mk-app RTy [x]} IL (BL x)), distribute-abstraction Name Ty BL TL. params (record _ _ _ RD) RTy IL TL :- build-lens RD 0 RTy IL TL. params (inductive ID _ _ _) _ _ _ :- M is "derive.lens: " ^ ID ^ " is not a record", stop M. % distributes a lambda abstraction to all items in the list pred distribute-abstraction i:name, i:term, i:(term -> list term), o:list term. distribute-abstraction _ _ (_\[]) []. distribute-abstraction Name Ty (x\[T x|L x]) [fun Name Ty T|L1] :- distribute-abstraction Name Ty L L1. % typechecks and declares the lens pred declare-lens i:string, i:inductive, i:id, i:term, o:prop. declare-lens Prefix I FieldName RawBody (lens-db I FieldName C):- Name is Prefix ^ FieldName, coq.env.indt I _ Nparams _ _ _ _, % In order to support primitive records we call the elaborator, which % eventually compiles the match into primitive projections std.assert-ok! (coq.elaborate-skeleton RawBody Ty Body) "derive.lens generates illtyped term", coq.env.add-const Name Body Ty @transparent! C, std.map {std.iota Nparams} (_\r\ r = maximal) Implicits, if (Nparams > 0) (@global! => coq.arguments.set-implicit (const C) [Implicits, []]) true. pred main i:inductive, i:string, o:list prop. main I Prefix Clauses :- std.do! [ coq.env.indt-decl I Decl, % easy to recurse on params Decl (global (indt I)) Names Defs, std.map2 Names Defs (declare-lens Prefix I) Clauses, std.forall Clauses (c\coq.elpi.accumulate _ "derive.lens.db" (clause _ _ c)), ]. } coq-elpi-1.19.3/apps/derive/elpi/lens_laws.elpi000066400000000000000000000112071451177652200213450ustar00rootroot00000000000000/* Equations on lenses */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive.lens-laws { pred declare-law1 i:string, i:prop. declare-law1 Prefix (lens-db I F C) :- std.do! [ coq.env.indt-decl I Decl, law1 Decl (global (const C)) (global (indt I)) Bo, Name is Prefix ^ F ^ "_view_set", coq.env.add-const Name Bo _ @opaque! _, ]. pred law1 i:indt-decl, i:term, i:term, o:term. law1 (parameter ID _ Ty Rest) Lens Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law1 (Rest p) {coq.mk-app Lens [p]} {coq.mk-app Ind [p]} (Bo p). law1 _ Lens IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law1-rty.aux Lens) law1-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.view_set lp:Lens }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law1 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law1 proof illtyped". law1-rty.aux L _ Vs _ {{ lib:elpi.derive.lens.view_set_on lp:L lp:R }} :- std.last Vs R. law1-bo.aux _ _ _ _ {{ fun x => lib:@elpi.erefl _ _ }}. pred declare-law2 i:string, i:prop. declare-law2 Prefix (lens-db I F C) :- std.do! [ coq.env.indt-decl I Decl, law2 Decl (global (const C)) (global (indt I)) Bo, Name is Prefix ^ F ^ "_set_set", coq.env.add-const Name Bo _ @opaque! _, ]. pred law2 i:indt-decl, i:term, i:term, o:term. law2 (parameter ID _ Ty Rest) Lens Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law2 (Rest p) {coq.mk-app Lens [p]} {coq.mk-app Ind [p]} (Bo p). law2 _ Lens IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law2-rty.aux Lens) law2-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.set_set lp:Lens }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law2 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law2 proof illtyped". law2-rty.aux L _ Vs _ {{ lib:elpi.derive.lens.set_set_on lp:L lp:R }} :- std.last Vs R. law2-bo.aux _ _ _ _ {{ fun x y => lib:@elpi.erefl _ _ }}. pred declare-law3 i:string, i:prop. declare-law3 Prefix (lens-db I F C) :- std.do! [ coq.env.indt-decl I Decl, law3 Decl (global (const C)) (global (indt I)) Bo, Name is Prefix ^ F ^ "_set_view", coq.env.add-const Name Bo _ @opaque! _, ]. pred law3 i:indt-decl, i:term, i:term, o:term. law3 (parameter ID _ Ty Rest) Lens Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law3 (Rest p) {coq.mk-app Lens [p]} {coq.mk-app Ind [p]} (Bo p). law3 _ Lens IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law3-rty.aux Lens) law3-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.set_view lp:Lens }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law3 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law3 proof illtyped". law3-rty.aux L _ Vs _ {{ lib:elpi.derive.lens.set_view_on lp:L lp:R }} :- std.last Vs R. law3-bo.aux _ _ _ _ {{ lib:@elpi.erefl _ _ }}. pred declare-law4 i:string, i:prop, i:prop. declare-law4 _ (lens-db I F C) (lens-db I F C) :- !. declare-law4 Prefix (lens-db I F1 C1) (lens-db I F2 C2) :- std.do! [ coq.env.indt-decl I Decl, law4 Decl (global (const C1)) (global (const C2)) (global (indt I)) Bo, Name is Prefix ^ F1 ^ "_" ^ F2 ^ "_exchange", coq.env.add-const Name Bo _ @opaque! _, ]. pred law4 i:indt-decl, i:term, i:term, i:term, o:term. law4 (parameter ID _ Ty Rest) Lens1 Lens2 Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law4 (Rest p) {coq.mk-app Lens1 [p]} {coq.mk-app Lens2 [p]} {coq.mk-app Ind [p]} (Bo p). law4 _ Lens1 Lens2 IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law4-rty.aux Lens1 Lens2) law4-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.exchange lp:Lens1 lp:Lens2 }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law4 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law4 proof illtyped". law4-rty.aux L1 L2 _ Vs _ {{ lib:elpi.derive.lens.exchange_on lp:L1 lp:L2 lp:R }} :- std.last Vs R. law4-bo.aux _ _ _ _ {{ fun x y => lib:@elpi.erefl _ _ }}. pred main i:inductive, i:string, o:list prop. main I Prefix [lens-laws-done I] :- std.do! [ std.findall (lens-db I F_ L_) Lenses, std.forall Lenses (declare-law1 Prefix), std.forall Lenses (declare-law2 Prefix), std.forall Lenses (declare-law3 Prefix), std.forall Lenses (l1\ std.forall Lenses (l2\ declare-law4 Prefix l1 l2)), coq.elpi.accumulate _ "derive.lens_laws.db" (clause _ _ (lens-laws-done I)), ]. } coq-elpi-1.19.3/apps/derive/elpi/map.elpi000066400000000000000000000156121451177652200201370ustar00rootroot00000000000000/* map over a container */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{split-at, length, rev, append, do!, drop-last, assert!}. map-db (app[global (indt GR1)|A1]) (app[global (indt GR2)|A2]) R :- coq.env.indt GR1 _ Lno1 _ _ _ _, coq.env.indt GR2 _ Lno2 _ _ _ _, {length A1} > Lno1, {length A2} > Lno2, split-at Lno1 A1 Args1 Points1, split-at Lno2 A2 Args2 Points2, Points1 = Points2, !, map-db {coq.mk-app (global (indt GR1)) Args1} {coq.mk-app (global (indt GR2)) Args2} F, coq.mk-app F Points1 R. namespace derive.map { % Building the body %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred bo-idx i:term, % inductive arity (input) i:term, % inductive type (input) applied to params & idx handled so far i:term, % inductive type (output) applied to params & idx handled so far i:int, % current index no o:int, % Recno i:list term, % rev list of (output) parameters o:term, % body o:term. % type bo-idx (prod _ S1 T1) Ity1 Ity2 N M Ps (fun `x` S1 Bo) (prod `x` S1 Ty) :- !, pi x\ sigma Ity1x Ity2x\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [x] Ity2x, N1 is N + 1, decl x `x` S1 => bo-idx (T1 x) Ity1x Ity2x N1 M Ps (Bo x) (Ty x). bo-idx (sort _) Ity1 Ity2 N N Ps (fun `x` Ity1 Bo) (prod `_` Ity1 _\ Ity2) :- !, @pi-decl `x` Ity1 x\ coq.build-match x Ity1 (bo-idx-rty Ps Ity2) (bo-k-args Ps) (Bo x). bo-idx X Ity1 Ity2 N M Ps R1 R2 :- whd1 X X1, !, bo-idx X1 Ity1 Ity2 N M Ps R1 R2. pred bo-idx-rty i:list term, i:term, i:term, i:list term, i:list term, o:term. bo-idx-rty Ps ItyArgs _ Vs _ R :- rev Vs [_|IdxsRev], rev IdxsRev Idxs, coq.safe-dest-app ItyArgs HD _, coq.mk-app HD {append {rev Ps} Idxs} R. pred bo-k-args i:list term, i:term, i:term, i:list term, i:list term, o:term. bo-k-args ParamsRev K _ Args Tys R :- rev ParamsRev Params, coq.safe-dest-app K (global (indc GR)) _, coq.env.typeof (indc GR) T, coq.subst-prod Params T KT, (bo-k-args.aux {coq.mk-app (global (indc GR)) Params} Args Tys KT R), !. % the first combination that typechecks bo-k-args.aux R [] [] _ R :- coq.typecheck R _ ok. bo-k-args.aux K [A|As] [T|Ts] (prod _ S Ty) R :- map-db T S F, coq.mk-app F [A] FA, bo-k-args.aux {coq.mk-app K [FA]} As Ts (Ty FA) R. bo-k-args.aux K [A|As] [_|Ts] (prod _ _ Ty) R :- !, bo-k-args.aux {coq.mk-app K [A]} As Ts (Ty A) R. bo-k-args.aux K As Ts X R :- whd1 X X1, !, bo-k-args.aux K As Ts X1 R. % Take in input a mapping function for each parameter % and then do the fixpoint pred bo-params i:int, % current parameter i:int, % number of parameters i:term, % inductive type (input) applied to parameters handled so far i:term, % inductive type (output) applied to parameters handled so far i:term, % inductive arity (input) i:term, % inductive arity (output) i:list term, % output parameters so far o:term. % map function bo-params Lno Lno Ity1 Ity2 A1 _ Ps (fix `f` Recno Fty Bo) :- coq.safe-dest-app Ity1 (global (indt I)) _, coq.env.recursive? I, !, @pi-decl `rec` Fty f\ map-db Ity1 Ity2 f => bo-idx A1 Ity1 Ity2 0 Recno Ps (Bo f) Fty. bo-params Lno Lno Ity1 Ity2 A1 _ Ps Bo :- bo-idx A1 Ity1 Ity2 0 _ Ps Bo _. bo-params N Lno Ity1 Ity2 (prod A Sty1 Rty1) (prod _ Sty2 Rty2) Ps R :- coq.name-suffix A 1 A1, coq.name-suffix A 2 A2, coq.name-suffix A "f" Af, N1 is N + 1, (pi a b f \ mk-map-ty a Sty1 b Sty2 (FAB a b) f _ (Clause a b f)), R = (fun A1 Sty1 a\ fun A2 Sty2 b\ fun Af (FAB a b) f\ Bo a b f), pi a b f\ sigma Ity1A Ity2A \ coq.mk-app Ity1 [a] Ity1A, coq.mk-app Ity2 [b] Ity2A, Clause a b f => decl a A1 Sty1 => decl b A2 Sty2 => decl f Af (FAB a b) => bo-params N1 Lno Ity1A Ity2A (Rty1 a) (Rty2 b) [b|Ps] (Bo a b f). bo-params N Lno Ity1 Ity2 T OT Ps R :- whd1 T T1, whd1 OT OT1, !, bo-params N Lno Ity1 Ity2 T1 OT1 Ps R. bo-params _ _ _ _ _ _ _ _ :- stop "derive.map: Indexed data types not supported". pred map-pi i:A, o:list prop. map-pi (x\ []) []. map-pi (x\ [X x| XS x]) [pi x\ X x | YS] :- map-pi XS YS. pred mk-map-ty i:term, % input variable i:term, % and its type i:term, % output variable i:term, % an its type o:term, % type of a mapping function from input to output i:term, % map function (having the type above) o:int, % arity of the predicate o:list prop. % map-db clause for map function mk-map-ty A (prod _ SA T1) B (prod _ SB T2) (prod `x` SA x\ R x) F N C1 :- map-db SA SB Fa, !, (pi x\ sigma Ax Fx BFx \ coq.mk-app A [x] Ax, coq.mk-app Fa [x] Fx, coq.mk-app B [Fx] BFx, mk-map-ty Ax (T1 x) BFx (T2 BFx) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty A (prod _ S1 T1) B (prod _ _ T2) (prod `x` S1 x\ R x) F N C1 :- (pi x\ sigma Ax Bx \ coq.mk-app A [x] Ax, coq.mk-app B [x] Bx, mk-map-ty Ax (T1 x) Bx (T2 x) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty (app[X|XS] as A) _ (app[Y|YS] as B) _ (prod `x` A _\ B) (app [G|GS] as F) 0 [map-db PLA PLB PLF,map-db A B F] :- drop-last 1 XS LA, drop-last 1 YS LB, drop-last 1 GS LF, coq.mk-app X LA PLA, coq.mk-app Y LB PLB, coq.mk-app G LF PLF. mk-map-ty A _ B _ (prod `x` A _\ B) F 0 [map-db A B F]. % Build a clause %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred mk-clause i:int, % current parameter i:int, % number of parameters i:term, % inductive type (input) i:term, % inductive type (output) i:term, % arity of the inductive i:list prop, % premises of the clause i:term, % map function o:prop. % clause for map-db mk-clause N N Ity1 Ity2 _ Todo Map (map-db Ity1 Ity2 Map :- Todo). mk-clause N Lno Ity1 Ity2 (prod _ _ T) Todo Map (pi x y f\ C x y f) :- !, N1 is N + 1, pi x y f\ sigma Ity1x Ity2y Mapf\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [y] Ity2y, coq.mk-app Map [x,y,f] Mapf, mk-clause N1 Lno Ity1x Ity2y (T x) [map-db x y f|Todo] Mapf (C x y f). mk-clause N Lno Ity1 Ity2 X Todo Map C :- whd1 X X1, !, mk-clause N Lno Ity1 Ity2 X1 Todo Map C. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred main i:inductive, i:string, o:list prop. main GR Prefix C :- do! [ T = global (indt GR), coq.env.indt GR _Ind Lno Luno Arity _ _, assert! (Lno = Luno) "derive.map: Non-uniform parameters not supported", % generate map and add to the env bo-params 0 Lno T T Arity Arity [] RSkel, std.assert-ok! (coq.elaborate-skeleton RSkel Rty R) "derive.map generates illtyped term", Name is Prefix ^ "map", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R Rty @transparent! Funct, % generate clause and add to the db mk-clause 0 Lno T T Arity [] (global (const Funct)) Clause, coq.elpi.accumulate _ "derive.map.db" (clause _ _ Clause), coq.elpi.accumulate _ "derive.map.db" (clause _ _ (map-done GR)), C = [map-done GR,Clause] ]. } coq-elpi-1.19.3/apps/derive/elpi/param1.elpi000066400000000000000000000163451451177652200205470ustar00rootroot00000000000000/* Unary parametricity translation (Realizability) */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % Author: Cyril Cohen shorten std.{forall, forall2, do!, rev, map2, map}. :before "subst-fun:fail" coq.subst-fun XS T TXS :- !, coq.mk-app T XS TXS. % this is outside the namespace since the predicate is also the db-one reali (sort prop as P) (fun `s` P x\ prod `s1` x _\ P) :- !. reali (sort _) (fun `s` (sort (typ U)) x\ prod `s1` x _\ (sort (typ V))) :- !, coq.univ.new U, coq.univ.new V. reali (fun N T B) (fun N T x\ fun N1 (TRsubst x) xR\ BR x xR) :- !, do! [ coq.name-suffix `P` N N1, reali T TR, (pi x xR\ reali x xR => reali (B x) (BR x xR)), (TRsubst = x\ {coq.subst-fun [x] TR}) ]. reali (prod N T P as Prod) ProdR :- !, do! [ coq.name-suffix `P` N N1, reali T TR, (pi x xR\ reali x xR => reali (P x) (PR x xR)), ProdR = fun `f` Prod f\ prod N T x\ prod N1 {coq.subst-fun [x] TR} xR\ {coq.subst-fun [{coq.mk-app f [x]}] (PR x xR)} ]. reali (app [A|Bs]) ARBsR :- !, do! [ reali A AR, derive.param1.reali-args Bs BsR, coq.mk-app AR BsR ARBsR ]. reali (let N T V B) LetR :- !, std.do! [ coq.name-suffix `P` N N1, reali T TR, reali V VR, (pi x xR\ reali x xR => reali (B x) (BR x xR)), LetR = let N T V x\ let N1 {coq.mk-app TR [x]} VR xR\ BR x xR ]. reali (match T P Bs) MR :- !, do! [ reali T TR, derive.param1.reali-match P PRM, reali T TR => derive.param1.reali-map Bs BsR, MR = match TR (PRM (x\ match x P Bs)) BsR ]. reali (fix N Rno T F as Fix) FixR :- !, std.do! [ RnoR is 2 * Rno + 1, RnoR1 is RnoR + 1, reali T TR, (pi x xR\ reali x xR => reali (F x) (FR x xR)), (TRsubst = f\ {coq.subst-fun [f] TR}), (pi f xR\ FixBody f xR = let N (TRsubst (F f)) (FR f xR) fr\ {paramX.mk-trivial-match RnoR (TRsubst f) [] fr}), (pi f xR\ coq.mk-eta RnoR1 (TRsubst f) (FixBody f xR) (EtaFixBody f xR)), coq.name-suffix N 1 N1, FixR = (let N T Fix f\ fix N1 RnoR (TRsubst f) xR\ EtaFixBody f xR), ]. namespace derive.param1 { pred reali-args o:list term, o:list term. reali-args [] []. reali-args [X|Xs] [X,XR|XsR] :- do! [ reali X XR, reali-args Xs XsR ]. pred reali-map o:list term, o:list term. reali-map [] []. reali-map [X|Xs] [XR|XsR] :- do! [ reali X XR, reali-map Xs XsR ]. % helpers for match return type pred reali-match i:term, o:((term -> term) -> term). reali-match (fun N T B) PRM :- pi x\ not (B x = fun _ _ _), !, do! [ reali T TR, (pi x xR\ reali x xR => reali (B x) (BR x xR)), coq.name-suffix `P` N N1, (pi z z1\ PRM z = fun N T x\ fun N1 {coq.subst-fun [x] TR} xR\ {coq.mk-app (BR x xR) [z x]}) ]. reali-match (fun N T B) PRM :- do! [ reali T TR, (pi x xR\ reali x xR => reali-match (B x) (BR x xR)), coq.name-suffix N 1 N1, (pi z \ PRM z = fun N T x\ fun N1 {coq.subst-fun [x] TR} xR\ BR x xR z) ]. % Storage: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred reali-store i:string, % Name suffix for the type class i:term, % Term i:term. % Translation reali-store N X XR :- !, Nreali is "reali_" ^ N, Args = [_, _, X, XR], T1 = app [{{ lib:@param1.store_reali }}|Args], std.assert-ok! (coq.typecheck T1 T2) "reali-store: T1 illtyped", coq.ensure-fresh-global-id Nreali FNreali, coq.env.add-const FNreali T1 T2 _ GR, @global! => coq.TC.declare-instance (const GR) 0. pred reali-store-indc i:string, i:constructor, i:constructor. reali-store-indc Prefix K XR :- reali-store {calc (Prefix ^ {coq.gref->id (indc K)})} (global (indc K)) (global (indc XR)). % toplevel predicates %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred dispatch i:gref, % input of the translation i:string, % the name o:list prop. % the clause dispatch (const GR) Prefix Clauses :- !, do! [ Term = global (const GR), Name is Prefix ^ {coq.gref->id (const GR)}, std.assert! (coq.env.const GR (some V) Ty) "param1: cannot handle axioms", reali V VR, reali Ty TyR, coq.mk-app TyR [Term] TyRV, % apparently calling the type checker with the expected type is weaker in this case std.assert-ok! (coq.typecheck VR VRTy) "param1: illtyped constant", std.assert-ok! (coq.unify-leq VRTy TyRV) "param1: constant does not have the right type", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName VR TyRV _ TermR, reali-store Name Term (global (const TermR)), C1 = (reali Term (global (const TermR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") C1), C2 = (realiR Term (global (const TermR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "realiR:fail") C2), coq.elpi.accumulate _ "derive.param1.db" (clause _ _ (reali-done (const GR))), Clauses = [C1, C2, reali-done (const GR)] ]. pred prefix-indc i:string, i:constructor, o:pair constructor id. prefix-indc Prefix K (pr K NewName) :- coq.gref->id (indc K) Name, NewName is Prefix ^ Name. dispatch (indt GR) Prefix Clauses :- !, do! [ Ind = global (indt GR), coq.env.indt GR _ _ Lno Ty Knames Ktypes, LnoR is 2 * Lno, pi new_name\ sigma KnamesR KtypesR TyR\ ( reali Ind (global (indt new_name)) => reali Ty TyR, reali Ind (global (indt new_name)) => map2 Knames Ktypes (k\ ty\ r\ sigma tyr\ reali ty tyr, coq.subst-fun [global (indc k)] tyr r) KtypesR, map Knames (prefix-indc Prefix) KnamesR, NewName is Prefix ^ {coq.gref->id (indt GR)}, coq.ensure-fresh-global-id NewName FNewName, coq.build-indt-decl (pr new_name FNewName) tt LnoR LnoR {coq.subst-fun [Ind] TyR} KnamesR KtypesR DeclR ), std.assert-ok! (coq.typecheck-indt-decl DeclR) "derive.param1 generates illtyped inductive", coq.env.add-indt DeclR GRR, reali-store NewName Ind (global (indt GRR)), coq.env.indt GRR _ _ _ _ RealNamesR _, Prefix1 is NewName ^ "_", forall2 Knames RealNamesR (reali-store-indc Prefix1), C1 = (reali Ind (global (indt GRR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") C1), C2 = (realiR Ind (global (indt GRR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "realiR:fail") C2), map2 Knames RealNamesR (a\ b\ r\ r = reali (global (indc a)) (global (indc b))) CK, forall CK (c\ coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") c)), coq.elpi.accumulate _ "derive.param1.db" (clause _ _ (reali-done (indt GR))), Clauses = [reali-done (indt GR), C1,C2|CK] ]. dispatch (indc _) _ _ :- coq.error "derive.param1: cannot translate a constructor". pred main i:gref, i:string, o:list prop. main T _ Clauses :- dispatch T "is_" Clauses. } /* %%%%%%%%%%%%%%%%%%%%% % Tactic entrypoint % %%%%%%%%%%%%%%%%%%%%% % We disable coq-refiner :before "refiner-assign-evar" evar _ _ _ :- !. pred ctx->TC i:(list prop), o:(list (pair term term)). ctx->TC [] [] :- !. ctx->TC [decl X _ Ty |Xs] [pr X Ty|Is] :- !, ctx->TC Xs Is. ctx->TC [def X _ _ _ Ty |Xs] [pr X Ty|Is] :- !, ctx->TC Xs Is. solve _ [goal Ctx Ev (app[{{@reali}}, T, TR, X, XR]) _] _ :- !, coq.sigma.print, coq.say "goal->TC" {ctx->TC Ctx}, coq.say "searching reali for" X, reali T TR, reali X XR, Ev = app [{{@Reali}}, T, TR, X, XR], coq.typecheck Ev Ty ok, coq.say "Ty=" Ty. */ coq-elpi-1.19.3/apps/derive/elpi/param1_congr.elpi000066400000000000000000000045561451177652200217400ustar00rootroot00000000000000/* param1 holds on the full type */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{forall, map2-filter, do!}. namespace derive.param1.congr { pred body-params i:int, i:term, i:term, i:term, i:term, o:term. body-params 0 (prod X TX x\ prod P (PX x) (Ty x)) KArgs1 KArgs2 R RT :- !, R = {{ fun (x : lp:TX) (p1 p2 : lp:(PX x)) (e : lib:@elpi.eq lp:(PX x) p1 p2) => lp:(Bo x p1 p2 e) }}, RT = {{ forall (x : lp:TX) (p1 p2 : lp:(PX x)) (e : lib:@elpi.eq lp:(PX x) p1 p2), lp:(BoTy x p1 p2 e) }}, @pi-decl X TX x\ @pi-decl P (PX x) p1\ sigma OTy\ @pi-decl P (PX x) p2\ @pi-decl `e` {{ lib:@elpi.eq lp:{{PX x}} lp:p1 lp:p2 }} e\ Bo x p1 p2 e = match e (OT x p1) [B x p1], body-params 0 (Ty x p1) {coq.mk-app KArgs1 [x,p1]} {coq.mk-app KArgs2 [x,p2]} (B1 x p1 p2 e) (RTB x p1 p2 e), OT x p1 = {{ fun (i : lp:{{PX x}}) (eq : lib:@elpi.eq lp:{{PX x}} lp:p1 i) => lp:(OTy i eq) }}, (pi i eq \ copy p2 i => copy e eq => copy (RTB x p1 p2 e) (OTy i eq)), !, (copy p2 p1 => copy (B1 x p1 p2 e) (B x p1)), !, BoTy x p1 p2 e = OTy p2 e. body-params 0 Ty KArgs1 KArgs2 R RT :- !, R = {{ lib:@elpi.erefl lp:Ty lp:KArgs1 }}, RT = {{ lib:@elpi.eq lp:Ty lp:KArgs1 lp:KArgs2 }}. body-params N (prod X TX x\ prod P (PX x) (Ty x)) K1 K2 R RT :- N > 0, M is N - 2, R = {{ fun (x : lp:TX) (p : lp:(PX x)) => lp:(Bo x p) }}, RT = {{ forall (x : lp:TX) (p : lp:(PX x)), lp:(BT x p) }}, @pi-decl X TX x\ @pi-decl P (PX x) p\ body-params M (Ty x p) {coq.mk-app K1 [x,p]} {coq.mk-app K2 [x,p]} (Bo x p) (BT x p). pred main-k i:string, i:int, i:constructor, i:term, o:prop. main-k Prefix Lno K KT Clause :- do! [ Name is Prefix ^ {coq.gref->id (indc K)}, body-params Lno KT (global (indc K)) (global (indc K)) R RT_, % coq.say {coq.term->string R}, coq.typecheck R RT ok, coq.env.add-const Name R RT @transparent! Cst, Clause = param1-congr-db K (global (const Cst)) ]. pred main i:inductive, i:string, o:list prop. main GR Prefix Clauses :- coq.env.indt GR _ Lno _ _ K KT, map2-filter K KT (main-k Prefix Lno) Clauses, forall Clauses (x\ coq.elpi.accumulate _ "derive.param1.congr.db" (clause _ _ x)). } % vim:set ft=lprolog spelllang=: coq-elpi-1.19.3/apps/derive/elpi/param1_functor.elpi000066400000000000000000000212211451177652200222740ustar00rootroot00000000000000/* map over a container */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, length, split-at, drop-last, rev, append}. param1-functor-db (app[global (indt GR1)|A1]) (app[global (indt GR2)|A2]) R :- coq.env.indt GR1 _ Lno1 _ _ _ _, coq.env.indt GR2 _ Lno2 _ _ _ _, {length A1} > Lno1, {length A2} > Lno2, split-at Lno1 A1 Args1 Points1, split-at Lno2 A2 Args2 Points2, Points1 = Points2, !, param1-functor-db {coq.mk-app (global (indt GR1)) Args1} {coq.mk-app (global (indt GR2)) Args2} F, coq.mk-app F Points1 R. namespace derive.param1.functor { pred skip i:int. % position of a parameter that has to be skipped % Building the body %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred self o:term. pred bo-idx i:term, % inductive arity (input) i:term, % inductive type (input) applied to params & idx handled so far i:term, % inductive type (output) applied to params & idx handled so far i:int, % current index no o:int, % Recno i:list term, % rev list of (output) parameters o:term, % body o:term. % type bo-idx (prod _ S1 T1) Ity1 Ity2 N M Ps (fun `x` S1 Bo) (prod `x` S1 Ty) :- !, pi x\ sigma Ity1x Ity2x\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [x] Ity2x, N1 is N + 1, decl x `x` S1 => bo-idx (T1 x) Ity1x Ity2x N1 M Ps (Bo x) (Ty x). bo-idx (sort _) Ity1 Ity2 N N Ps (fun `x` Ity1 Bo) (prod `_` Ity1 _\ Ity2) :- !, @pi-decl `x` Ity1 x\ coq.build-match x Ity1 (bo-idx-rty Ps Ity2) (bo-k-args Ps) (Bo x). bo-idx X Ity1 Ity2 N M Ps R1 R2 :- whd1 X X1, !, bo-idx X1 Ity1 Ity2 N M Ps R1 R2. pred bo-idx-rty i:list term, i:term, i:term, i:list term, i:list term, o:term. bo-idx-rty Ps ItyArgs _ Vs _ R :- rev Vs [_|IdxsRev], rev IdxsRev Idxs, coq.safe-dest-app ItyArgs HD _, coq.mk-app HD {append {rev Ps} Idxs} R. pred bo-k-args i:list term, i:term, i:term, i:list term, i:list term, o:term. bo-k-args ParamsRev K _ Args Tys R :- rev ParamsRev Params, coq.safe-dest-app K (global (indc GR)) _, coq.env.typeof (indc GR) T, coq.subst-prod Params T KT, (bo-k-args.aux {coq.mk-app (global (indc GR)) Params} Args Tys KT R). bo-k-args.aux K [A,PA|Args] [_,TPA|Types] {{ forall x (px : lp:(TPB x)), lp:(Ty x px) }} R :- not(same_term TPA (TPB A)), param1-functor-db TPA (TPB A) F, !, coq.mk-app K [A, {{ lp:F lp:PA }}] KAPFA, bo-k-args.aux KAPFA Args Types (Ty A KAPFA) R. bo-k-args.aux K [A,PA|Args] [_,_|Types] {{ forall x px, lp:(Ty x px) }} R :- coq.mk-app K [A,PA] KAPA, bo-k-args.aux KAPA Args Types (Ty A KAPA) R. bo-k-args.aux R [] [] _ R. % Take in input a mapping function for each parameter (not to be skipped) % and then do the fixpoint pred bo-params i:int, % current parameter i:int, % number of parameters i:term, % inductive type (input) applied to parameters handled so far i:term, % inductive type (output) applied to parameters handled so far i:term, % inductive arity (input) i:term, % inductive arity (output) i:list term, % output parameters so far o:term. % map function pred mk-rec-clause i:term, i:term, i:term, i:term, o:prop. mk-rec-clause (prod _ _ x\prod _ _ (P x)) T1 T2 F (pi x px\C x px) :- pi x px\ mk-rec-clause (P x px) {coq.mk-app T1 [x,px]} {coq.mk-app T2 [x,px]} {coq.mk-app F [x,px]} (C x px). mk-rec-clause (prod _ _ _\sort _) T1 T2 F (param1-functor-db T1 T2 F). pred mk-rec-clause-app i:term, i:term, i:term, i:term, o:prop. mk-rec-clause-app (prod _ _ x\prod _ _ (P x)) T1 T2 F (pi x px py\C x px py) :- pi x px py\ mk-rec-clause-app (P x px) {coq.mk-app T1 [x,px]} {coq.mk-app T2 [x,py]} {coq.mk-app F [x,px]} (C x px py). mk-rec-clause-app (prod _ _ _\sort S) T1 T2 F (pi x\C x) :- pi x \ mk-rec-clause-app (sort S) {coq.mk-app T1 [x]} {coq.mk-app T2 [x]} {coq.mk-app F [x]} (C x). mk-rec-clause-app (sort _) T1 T2 F (param1-functor-db T1 T2 F). bo-params Lno Lno Ity1 Ity2 A1 _ Ps (fix `f` Recno Fty Bo) :- !, @pi-decl `rec` Fty f\ mk-rec-clause A1 Ity1 Ity2 f (C f), mk-rec-clause-app A1 Ity1 Ity2 f (D f), (D f) => (C f) => bo-idx A1 Ity1 Ity2 0 Recno Ps (Bo f) Fty. bo-params N Lno Ity1 Ity2 {{ forall (a : lp:T1) (p : a -> Type), lp:(Rty1 a p) }} {{ forall (a : _) (p : a -> Type), lp:(Rty2 a p) }} Ps R :- whd T1 [] {{ Type }} [], !, N1 is N + 2, (pi a b f \ mk-map-ty a {{ lp:a -> Type }} b {{ lp:b -> Type }} (FAB a b) f _ (Clause a b f)), R = {{ fun (a : Type) (pa pb : a -> Type) (f : forall x : a, pa x -> pb x) => lp:(Bo a pa pb f) }}, pi a pa pb f\ sigma Ity1A Ity2A \ coq.mk-app Ity1 [a,pa] Ity1A, coq.mk-app Ity2 [a,pb] Ity2A, Clause pa pb f => decl a `a` {{ Type }} => decl pa `pa` {{ lp:a -> Type }} => decl pb `pb` {{ lp:a -> Type }} => decl f `f` (FAB pa pb) => bo-params N1 Lno Ity1A Ity2A (Rty1 a pa) (Rty2 a pb) [pb,a|Ps] (Bo a pa pb f). bo-params N Lno Ity1 Ity2 (prod A Sty1 Rty1) (prod _ _ Rty2) Ps R :- N1 is N + 1, R = (fun A Sty1 a\ Bo a), pi a\ sigma Ity1A Ity2A \ coq.mk-app Ity1 [a] Ity1A, coq.mk-app Ity2 [a] Ity2A, decl a A Sty1 => bo-params N1 Lno Ity1A Ity2A (Rty1 a) (Rty2 a) [a|Ps] (Bo a). pred map-pi i:A, o:list B. map-pi (x\ []) []. map-pi (x\ [X x| XS x]) [pi x\ X x | YS] :- map-pi XS YS. pred mk-map-ty i:term, % input variable i:term, % and its type i:term, % output variable i:term, % an its type o:term, % type of a mapping function from input to output i:term, % map function (having the type above) o:int, % arity of the predicate o:list prop. % param1-functor-db clause for map function mk-map-ty A (prod _ SA T1) B (prod _ SB T2) (prod `x` SA x\ R x) F N C1 :- param1-functor-db SA SB Fa, !, (pi x\ sigma Ax Fx BFx \ coq.mk-app A [x] Ax, coq.mk-app Fa [x] Fx, coq.mk-app B [Fx] BFx, mk-map-ty Ax (T1 x) BFx (T2 BFx) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty A (prod _ S1 T1) B (prod _ _ T2) (prod `x` S1 x\ R x) F N C1 :- (pi x\ sigma Ax Bx \ coq.mk-app A [x] Ax, coq.mk-app B [x] Bx, mk-map-ty Ax (T1 x) Bx (T2 x) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty (app[X|XS] as A) _ (app[Y|YS] as B) _ (prod `x` A _\ B) (app [G|GS] as F) 0 [param1-functor-db PLA PLB PLF,param1-functor-db A B F] :- drop-last 1 XS LA, drop-last 1 YS LB, drop-last 1 GS LF, coq.mk-app X LA PLA, coq.mk-app Y LB PLB, coq.mk-app G LF PLF. mk-map-ty A _ B _ (prod `x` A _\ B) F 0 [param1-functor-db A B F]. % Build a clause %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred mk-clause i:int, % current parameter i:int, % number of parameters i:term, % inductive type (input) i:term, % inductive type (output) i:term, % arity of the inductive i:list prop, % premises of the clause i:term, % map function o:prop, i:inductive, i:list bool, o:prop. % clause for param1-functor-db mk-clause N N Ity1 Ity2 _ Todo Map (param1-functor-db Ity1 Ity2 Map :- Todo) I Mask (param1-functor-for I F MaskRev) :- coq.safe-dest-app Map (global F) _, std.rev Mask MaskRev. mk-clause N Lno Ity1 Ity2 {{ forall (a : lp:Ty) (pa : a -> Type), lp:(T a pa) }} Todo Map (pi x px py f\ C x px py f) I M CF :- whd Ty [] {{ Type }} [], !, N1 is N + 2, pi x px py f\ sigma Ity1x Ity2y Mapf\ coq.mk-app Ity1 [x,px] Ity1x, coq.mk-app Ity2 [x,py] Ity2y, coq.mk-app Map [x,px,py,f] Mapf, mk-clause N1 Lno Ity1x Ity2y (T x px) [param1-functor-db px py f|Todo] Mapf (C x px py f) I [tt,ff|M] CF. mk-clause N Lno Ity1 Ity2 (prod _ _ T) Todo Map (pi x\ C x) I M CF :- !, N1 is N + 1, pi x\ sigma Ity1x Ity2x Mapf\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [x] Ity2x, coq.mk-app Map [x] Mapf, mk-clause N1 Lno Ity1x Ity2x (T x) Todo Mapf (C x) I [ff|M] CF. mk-clause N Lno Ity1 Ity2 X Todo Map C I M CF :- whd1 X X1, !, mk-clause N Lno Ity1 Ity2 X1 Todo Map C I M CF. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred main i:inductive, i:string, o:list prop. main GR Suffix C :- do! [ coq.env.indt GR _Ind Lno Luno Arity _ _, assert! (Lno = Luno) "derive.param1.functor: Non-uniform parameters not supported", % generate map and add to the env T = global (indt GR), bo-params 0 Lno T T Arity Arity [] R, std.assert-ok! (coq.typecheck R Rty) "derive.param1_functor generates illtyped term", Name is {coq.gref->id (indt GR)} ^ Suffix, coq.env.add-const Name R Rty @transparent! Funct, % generate clause and add to the db mk-clause 0 Lno T T Arity [] (global (const Funct)) Clause1 GR [] Clause2, C = [Clause1, Clause2], std.forall C (x\coq.elpi.accumulate _ "derive.param1.functor.db" (clause _ _ x)), ]. } coq-elpi-1.19.3/apps/derive/elpi/param1_inhab.elpi000066400000000000000000000117071451177652200217050ustar00rootroot00000000000000/* param1 holds on the full type */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{zip, assert!, do!, map, map2, rev}. namespace derive.param1.inhab { % local data base to map a constructor K of T (applied to params) to % the pair isK and its type, eg ({{Zero}} `-> pr {{isZero}} {{isNat Zero}})) type (`->) term -> pair term term -> prop. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred search i:term, i:term, o:term. % given T and isT it builds a proof forall x:T, isT x search _ Goal P :- std.assert! (param1-inhab-db Goal P) "derive.param1_inhab: cannot prove inhabitation". %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred prove-args % for each (K x ..) we must produce (isK x x_isX ..) i:list term, % the variables (x in the example above) i:term, % the type of isK o:list term. % x and x_isX prove-args [] _ []. prove-args [V|VS] (prod _ T x\ prod _ _ (px\ F x px)) [V,PV | RS] :- reali T TR, !, % out of the type of x we get isX search T TR PT, % PT is a proof that forall x, isX x PV = app[PT,V], % PV is the x_isX above reali V PV => prove-args VS (F V PV) RS. pred oty i:(term -> term), i:term, i:list term, i:list term, o:term. oty F _ V _ R :- rev V [X|_], R = F X. pred body i:term, i:term, i:list term, i:list term, o:term. body K _ V _ R :- coq.safe-dest-app K Kname _, Kname `-> (pr KR KRT), prove-args V KRT Args, coq.mk-app KR Args R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred body-params i:int, % number of params left i:term, % inductive type applied to parameters treated so far i:term, % inductive type arity to process i:list term, % construcors applied to parameters treated so far i:list term, % construcor's types instantiated to parameters treated so far o:term. body-params 0 IsT (prod _ T _\ sort _) K KT R :- coq.safe-dest-app T (global (indt GR)) _, coq.env.recursive? GR, !, RT = (x\ {coq.mk-app IsT [x]}), R = {{ fix IH (x : lp:T) {struct x} : lp:(RT x) := lp:(Bo IH x) }}, coq.env.indt GR _ _ _ _ KX _, map2 KX {zip K KT} (a\b\r\ r = (global (indc a)) `-> b) K2KR, K2KR => % K `-> (pr isK isKtype) @pi-decl `IH` (prod `x` T x\ RT x) f\ @pi-decl `x` T x\ param1-inhab-db IsT f => coq.build-match x T (oty RT) body (Bo f x). body-params 0 IsT (prod _ T _\ sort _) K KT R :- !, RT = (x\ {coq.mk-app IsT [x]}), R = {{ fun (x : lp:T) => lp:(Bo x) }}, coq.safe-dest-app T (global (indt GR)) _, coq.env.indt GR _ _ _ _ KX _, map2 KX {zip K KT} (a\b\r\ r = (global (indc a)) `-> b) K2KR, K2KR => % K `-> (pr isK isKtype) @pi-decl `x` T x\ coq.build-match x T (oty RT) body (Bo x). % param1 have the form : isT A (P : A -> Type) .. , so we process two % binders at a time and we assume (H : trivial P) for each A and P body-params N IsT (prod A TA a\ prod P (TP a) (F a)) K KT R :- N > 0, coq.sort? TA, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ fun _ {{ lib:elpi.derive.full lp:a lp:p }} pf\ Bo a p pf), @pi-decl A TA a\ @pi-decl P (TP a) p\ @pi-decl _ {{ lib:elpi.derive.full lp:a lp:p }} pf\ sigma KAP KTAP\ map K (k\ coq.mk-app k [a,p]) KAP, map KT (coq.subst-prod [a,p]) KTAP, reali a p => param1-inhab-db p pf => % to prove (P x) use (H x) body-params M {coq.mk-app IsT [a,p]} (F a p) KAP KTAP (Bo a p pf). body-params N IsT (prod A TA a\ prod P (TP a) (F a)) K KT R :- N > 0, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ Bo a p), @pi-decl A TA a\ @pi-decl P (TP a) p\ sigma KAP KTAP\ map K (k\ coq.mk-app k [a,p]) KAP, map KT (coq.subst-prod [a,p]) KTAP, reali a p => body-params M {coq.mk-app IsT [a,p]} (F a p) KAP KTAP (Bo a p). body-params _ IsT _ _ _ _ :- M is "derive.param1_inhab: wrong shape " ^ {coq.term->string IsT} ^ ". It does not look like a unary parametricity translation of an inductive with no indexes.", stop M. pred main i:inductive, i:string, o:list prop. main GR Suffix [ClauseW, param1-inhab-done GR] :- do! [ coq.env.indt GR Ind Lno Luno Arity K KT, assert! (Ind = tt) "derive.param1_inhab: Coinductive types are not supported", assert! (Lno = Luno) "derive.param1_inhab: Non-uniform parameters not supported", body-params Lno (global (indt GR)) Arity {std.map K (k\r\ r = global (indc k))} KT RSkel, % coq.say {coq.term->string R}, std.assert-ok! (coq.elaborate-skeleton RSkel RT R) "derive.param1_inhab generates illtyped term", Name is {coq.gref->id (indt GR)} ^ Suffix, coq.env.add-const Name R RT @transparent! Witness, ClauseW = (param1-inhab-db (global (indt GR)) (global (const Witness))), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ ClauseW), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ (param1-inhab-done GR)), ]. } coq-elpi-1.19.3/apps/derive/elpi/param1_trivial.elpi000066400000000000000000000117261451177652200222770ustar00rootroot00000000000000/* param1 holds on the full type */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, drop-last}. namespace derive.param1.trivial { pred prove-args i:list term, i:list term, o:list term. prove-args [] [] []. prove-args [X,PX|Rest] [TX,TPX_X|TRest] [X,P1,PX,P2|PRest] :- coq.safe-dest-app TPX_X HD ARGS, drop-last 1 ARGS ARG, coq.mk-app HD ARG TPX, param1-trivial-db TPX P, !, P1 = {{ lib:elpi.derive.trivial_full lp:TX lp:TPX lp:P lp:X }}, P2 = {{ lib:elpi.derive.trivial_uniq lp:TX lp:TPX lp:P lp:X lp:PX }}, prove-args Rest TRest PRest. pred oty i:term, i:term, i:term, i:list term, i:list term, o:term. oty IsT W _ [Idx,V] _ {{ lib:@elpi.eq lp:Ty lp:Wx lp:V }} :- Ty = app[IsT,Idx], Wx = app[W,Idx]. pred body i:term, i:term, i:term, i:term, i:list term, i:list term, o:term. body _ _ K (app _) V VT R :- std.do! [ /* coq.safe-dest-app K (global (indc Kname)) Params, prove-args V VT P, assert! (param1-congr-db Kname CongrK) "run derive.param1.congr first", coq.mk-app CongrK Params Rhd, coq.mk-app Rhd P R,*/ trivialize-param1 V VT Triv, do-args {std.rev V} {std.rev VT} {std.rev Triv} [] K R, ]. pred trivialize-param1 i:list term, i:list term, o:list term. trivialize-param1 [] [] []. trivialize-param1 [_,_|XS] [_,TPX|PS] [TPX1,T|TS] :- std.do! [ coq.safe-dest-app TPX HD ARGS, drop-last 1 ARGS ARG, coq.mk-app HD ARG TPX1, param1-trivial-db TPX1 T, trivialize-param1 XS PS TS, ]. pred do-args i:list term, i:list term, i:list term, i:list term, i:term, o:term. do-args [] [] [] _ _ {{ lib:@elpi.erefl _ _ }}. do-args [PX,X|XS] [_,TX|PS] [Triv,P|Trivs] Old K R :- std.do! [ Q = {{ lib:elpi.derive.trivial_uniq lp:TX lp:P lp:Triv lp:X lp:PX }}, F = {{ lib:elpi.derive.trivial_full lp:TX lp:P lp:Triv lp:X }}, std.assert-ok! (coq.typecheck Q TQ) "wtf", (pi v\ coq.mk-app K {std.rev {std.append {std.append Old [v,X]} XS}} (K1 v)), std.append Old [F,X] Old1, coq.build-match Q TQ (do-oty K1 PX) (do-body XS PS Trivs Old1 K) R, ]. pred do-oty i:(term -> term), i:term, i:term, i:list term, i:list term, o:term. do-oty K E _ [V,_] _ {{ lib:@elpi.eq _ _ lp:KV }} :- copy E V => copy (K V) KV. pred do-body i:list term, i:list term, i:list term, i:list term, i:term, i:term, i:term, i:list term, i:list term, o:term. do-body XS PS Trivs Old K _ _ _ _ R :- do-args XS PS Trivs Old K R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred body-params i:int, % number of params left i:term, % inductive type applied to parameters treated so far i:term, % inductive type arity to process o:term. body-params 0 IsT (prod _ T _\ sort _) R :- !, std.do! [ std.assert! (param1-inhab-db IsT W) "www", R = {{ fun x : lp:T => lib:elpi.derive.contracts lp:T lp:IsT x (lp:W x) ((fix IH (x : lp:T) (y : lp:IsT x) {struct y} : lib:@elpi.eq (lp:IsT x) (lp:W x) y := lp:{{ { param1-trivial-db IsT {{ fun x : lp:T => lib:elpi.derive.contracts lp:T lp:IsT x (lp:W x) (IH x) }} => coq.build-match {{y}} {{lp:IsT x}} (oty IsT W) (body IsT W) } }} ) x) }}, ]. % param1 have the form : isT A (P : A -> Type) .. , so we process two % binders at a time and we assume (H : trivial P) for each A and P body-params N T (prod A TA a\ prod P (TP a) (F a)) R :- N > 0, coq.sort? TA, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ fun _ {{ lib:elpi.derive.trivial lp:a lp:p }} pf\ { decl a A TA => decl p P (TP a) => decl pf `_` {{ lib:elpi.derive.trivial lp:a lp:p }} => reali a p => param1-trivial-db p pf => % to prove (P x) use (H x) param1-inhab-db p {{ lib:elpi.derive.trivial_full lp:a lp:p lp:pf }} => % to prove (P x) use (H x) body-params M {coq.mk-app T [a,p]} (F a p)}). body-params N T (prod A TA a\ prod P (TP a) (F a)) R :- N > 0, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ { decl a A TA => decl p P (TP a) => reali a p => body-params M {coq.mk-app T [a,p]} (F a p)}). body-params _ T _ _ :- coq.say "derive.param1_trivial: wrong shape " {coq.term->string T} ". It does not look like a unary parametricity translation of an inductive with no indexes.", fail. pred main i:inductive, i:string, o:list prop. main GR Suffix [Clause,param1-trivial-done GR] :- do! [ coq.env.indt GR _ Lno _ Arity _ _, body-params Lno (global (indt GR)) Arity R, % coq.say {coq.term->string R}, std.assert-ok! (coq.typecheck R RT) "derive.param1_trivial generates illtyped term", Name is {coq.gref->id (indt GR)} ^ Suffix, coq.env.add-const Name R RT @transparent! Cst, Clause = (param1-trivial-db (global (indt GR)) (global (const Cst))), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ Clause), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ (param1-trivial-done GR)), ]. } coq-elpi-1.19.3/apps/derive/elpi/param2.elpi000066400000000000000000000204111451177652200205350ustar00rootroot00000000000000/* Binary parametricity translation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % Author: Cyril Cohen shorten std.{forall, forall2, do!, rev, map2, map}. :before "subst-fun:fail" coq.subst-fun XS T TXS :- !, coq.mk-app T XS TXS. % this is outside the namespace since the predicate is also the db-one param (sort prop as P) P (fun `s` P x\ fun `s` P y\ prod `s1` x _\ prod `s2` y _\ P) :- !. param (sort _ as P) P (fun `u` (sort (typ U)) x\ fun `v` (sort (typ V)) y\ prod `s1` x _\ prod `s2` y _\ P) :- !, coq.univ.new U, coq.univ.new V. param (fun N T B) (fun N T1 B1) (fun N T x\ fun N T1 x1\ fun N (TRsubst x x1) xR\ BR x x1 xR) :- !, do! [ param T T1 TR, (pi x x1 xR\ param x x1 xR => param (B x) (B1 x1) (BR x x1 xR)), (TRsubst = x\ x1\ {coq.subst-fun [x,x1] TR}) ]. param (prod N T P as Prod) Prod1 ProdR :- !, do! [ param T T1 TR, (pi x x1 xR\ param x x1 xR => param (P x) (P1 x1) (PR x x1 xR)), Prod1 = prod N T1 P1, ProdR = fun `f` Prod f\ fun `g` Prod1 g\ prod N T x\ prod N T1 x1\ prod N {coq.subst-fun [x,x1] TR} xR\ {coq.subst-fun [{coq.mk-app f [x]}, {coq.mk-app g [x1]}] (PR x x1 xR)} ]. param (app [A|Bs]) (app [A1|Bs1]) ARBsR :- !, do! [ param A A1 AR, derive.param2.param-args Bs Bs1 BsR, coq.mk-app AR BsR ARBsR ]. param (let N T V B) Let1 LetR :- !, do! [ param T T1 TR, param V V1 VR, (pi x x1 xR\ param x x1 xR => param (B x) (B1 x1) (BR x x1 xR)), Let1 = let N T1 V1 B1, LetR = let N T V x\ let N T1 V1 x1\ let N {coq.mk-app TR [x,x1]} VR xR\ BR x x1 xR ]. param (match T P Bs) M1 MR :- !, do! [ param T T1 TR, derive.param2.param-match P P1 PRM, param T T1 TR => derive.param2.map-param Bs Bs1 BsR, M1 = match T1 P1 Bs1, MR = match TR (PRM (x\ match x P Bs) (x\ match x P1 Bs1)) BsR ]. param (fix N Rno T F as Fix) Fix1 FixR :- !, do! [ RnoR is 3 * Rno + 2, RnoR1 is RnoR + 1, param T T1 TR, (pi x x1 xR\ param x x1 xR => param (F x) (F1 x1) (FR x x1 xR)), Fix1 = fix N Rno T1 F1, (TRsubst = f\ f1\ {coq.subst-fun [f, f1] TR}), (pi f f1 xR\ FixBody f f1 xR = let N (TRsubst (F f) (F1 f1)) (FR f f1 xR) fr\ {paramX.mk-trivial-match RnoR (TRsubst f f1) [] fr}), (pi f f1 xR\ coq.mk-eta RnoR1 (TRsubst f f1) (FixBody f f1 xR) (EtaFixBody f f1 xR)), FixR = (let N T Fix f\ let N T1 Fix1 f1\ fix N RnoR (TRsubst f f1) xR\ EtaFixBody f f1 xR) ]. namespace derive.param2 { pred param-args o:list term, o:list term, o:list term. param-args [] [] [] :- !. param-args [X|Xs] [X1|Xs1] [X,X1,XR|XsR] :- !, param X X1 XR, !, param-args Xs Xs1 XsR, !. pred map-param o:list term, o:list term, o:list term. map-param [] [] [] :- !. map-param [X|Xs] [X1|Xs1] [XR|XsR]:- !, param X X1 XR, !, map-param Xs Xs1 XsR, !. % helpers for match return type pred param-match i:term, o:term, o:((term -> term) -> (term -> term) -> term). param-match (fun N T B) P1 PRM :- pi x\ not (B x = fun _ _ _), !, param T T1 TR, !, (pi x x1 xR\ param x x1 xR => param (B x) (B1 x1) (BR x x1 xR)), !, P1 = fun N T1 B1, (pi z z1\ PRM z z1 = fun N T x\ fun N T1 x1\ fun N {coq.subst-fun [x,x1] TR} xR\ {coq.mk-app (BR x x1 xR) [z x, z1 x1]}). param-match (fun N T B) P1 PRM :- param T T1 TR, !, (pi x x1 xR\ param x x1 xR => param-match (B x) (B1 x1) (BR x x1 xR)), !, P1 = fun N T1 B1, (pi z z1\ PRM z z1 = fun N T x\ fun N T1 x1\ fun N {coq.subst-fun [x,x1] TR} xR\ BR x x1 xR z z1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % translation of inductive types % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred param-indt i:inductive, i:bool, i:int, i:int, i:term, i:list term, i:list term, i:inductive, o:bool, o:int, o:int, o:term, o:list term. param-indt GR IsInd Lno _ Ty Knames Ktypes NameR IsInd LnoR LunoR TyR KtypesR :- do! [ LnoR is 3 * Lno, LunoR = LnoR, param (global (indt GR)) (global (indt GR)) (global (indt NameR)) => do! [ param Ty _ TyR, map2 Knames Ktypes param-indc KtypesR ] ]. pred rename-indc i:string, i:constructor, o:pair constructor id. rename-indc Suffix GR (pr GR NameR) :- coq.gref->id (indc GR) Name, NameR is Name ^ Suffix. pred param-indc i:term, i:term, o:term. param-indc K T TRK :- !, param T _ TR, coq.subst-fun [K, K] TR TRK. %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Class storage functions: % %%%%%%%%%%%%%%%%%%%%%%%%%%%% pred store-param i:string, i:term, i:term, i:term. store-param N X X1 XR :- !, Nparam is "param_" ^ N, Args = [_, _, _, X, X1, XR], T1 = app [{{ lib:@param2.store_param }}|Args], std.assert-ok! (coq.typecheck T1 T2) "store-param: T1 illtyped", coq.ensure-fresh-global-id Nparam FNparam, coq.env.add-const FNparam T1 T2 _ C, @global! => coq.TC.declare-instance (const C) 0. pred store-param-indc i:string, i:constructor, i:constructor. store-param-indc Suffix K KR :- store-param {calc ({coq.gref->id (indc K)} ^ Suffix)} (global (indc K)) (global (indc K)) (global (indc KR)). %%%%%%%%%%%%%%%%%%%%%%% % toplevel predicates % %%%%%%%%%%%%%%%%%%%%%%% pred dispatch i:gref, i:string, o:list prop. dispatch (const GR as C) Suffix Clauses :- do! [ Term = global C, NameR is {coq.gref->id C} ^ Suffix, coq.env.const GR (some X) Ty, param Ty _ TyR, coq.mk-app TyR [Term, Term] TyRTermTerm, param X _ XR, % apparently calling the type checker with the expected type is weaker in this case std.assert-ok! (coq.typecheck XR XRTy) "param2: illtyped constant", std.assert-ok! (coq.unify-leq XRTy TyRTermTerm) "param2: constant does not have the right type", coq.ensure-fresh-global-id NameR FNameR, coq.env.add-const FNameR XR TyRTermTerm _ TermR, store-param NameR Term Term (global (const TermR)), C1 = (param Term Term (global (const TermR)) :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") C1), C2 = (paramR Term Term (global (const TermR)) :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "paramR:fail") C1), coq.elpi.accumulate _ "derive.param2.db" (clause _ _ (param-done C)), Clauses = [param-done C, C1, C2] ]. dispatch (indt I as GR) Suffix Clauses :- do! [ Ind = global GR, coq.env.indt I IsInd Lno Luno Ty Knames Ktypes, NameR is {coq.gref->id GR} ^ Suffix, coq.ensure-fresh-global-id NameR FNameR, map Knames (rename-indc Suffix) KnamesR, std.map Knames (k\r\ r = global (indc k)) Ks, pi new_name\ sigma KtypesR TyR\ ( (param-indt I IsInd Lno Luno Ty Ks Ktypes new_name IsIndR LnoR LunoR TyR KtypesR), coq.build-indt-decl (pr new_name FNameR) IsIndR LnoR LunoR {coq.subst-fun [Ind, Ind] TyR} KnamesR KtypesR DeclR ), std.assert-ok! (coq.typecheck-indt-decl DeclR) "derive.param2 generates illtyped term", coq.env.add-indt DeclR GRR, store-param NameR Ind Ind (global (indt GRR)), coq.env.indt GRR _ _ _ _ RealNamesR _, forall2 Knames RealNamesR (store-param-indc Suffix), C1 = (param Ind Ind (global (indt GRR)) :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") C1), C2 = (paramR Ind Ind (global (indt GRR)) :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "paramR:fail") C2), map2 Knames RealNamesR (a\ b\ r\ r = param (global (indc a)) (global (indc a)) (global (indc b))) CK, forall CK (c\ coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") c)), coq.elpi.accumulate _ "derive.param2.db" (clause _ _ (param-done GR)), Clauses = [param-done GR,C1,C2|CK] ]. dispatch (indc _) _ _ :- coq.error "derive.param2: cannot translate a constructor". pred main i:gref, i:string, o:list prop. main T _ Clauses :- dispatch T "_R" Clauses. } /* %%%%%%%%%%%%%%%%%%%%% % Tactic entrypoint % %%%%%%%%%%%%%%%%%%%%% % We disable coq-refiner :before "refiner-assign-evar" evar _ _ _ :- !. pred ctx->TC i:(list prop), o:(list (pair term term)). ctx->TC [] [] :- !. ctx->TC [decl X _ Ty |Xs] [pr X Ty|Is] :- !, ctx->TC Xs Is. ctx->TC [def X _ _ _ Ty |Xs] [pr X Ty|Is] :- !, ctx->TC Xs Is. solve _ [goal Ctx Ev (app[{{@param}}, T, TR, X, XR]) _] _ :- !, coq.sigma.print, coq.say "goal->TC" {ctx->TC Ctx}, coq.say "searching param for" X, (param T _ TR), (param X _ XR), Ev = app [{{@Param}}, T, TR, X, XR], coq.typecheck Ev Ty ok, coq.say "Ty=" Ty. */ coq-elpi-1.19.3/apps/derive/elpi/paramX_lib.elpi000066400000000000000000000055011451177652200214340ustar00rootroot00000000000000/* coq-elpi: Coq terms as the object language of elpi */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace paramX { pred mk-trivial-match i:int, i:term, i:list term, i:term, o:term. mk-trivial-match Rno (prod N T P) Args F (fun N T B) :- Rno >= 0, !, std.do! [ Rno' is Rno - 1, (pi x\ decl x N T => mk-trivial-match Rno' (P x) [x|Args] F (B x)), ]. mk-trivial-match Rno Prod Args F R :- Rno >= 0, whd1 Prod Prod1, !, mk-trivial-match Rno Prod1 Args F R. mk-trivial-match -1 P RArgs F Match :- std.do! [ RArgs = [RecArg|ROtherArgs], (decl RecArg _ T, unwind {whd T []} Twhd), % unneeded with elpi 1.13.7 coq.safe-dest-app Twhd (global (indt I)) IndArgs, coq.env.indt I _ Lno _ _ _ _, std.drop Lno IndArgs RIndArgs, coq.build-match RecArg T (mk-trivial-match.rty {std.append RIndArgs [RecArg]} P) (mk-trivial-match.branch Lno RIndArgs {std.rev ROtherArgs} F) Match, ]. pred mk-trivial-match.rty i:list term, i:term, i:term, i:list term, i:list term, o:term. mk-trivial-match.rty Args P _ Vars _ R :- std.do! [ std.map2 Args Vars (x\y\r\ r = copy x y) Subst, Subst => copy P R, ]. pred mk-trivial-match.branch i:int, i:list term, i:list term, i:term, i:term, i:term, i:list term, i:list term, o:term. mk-trivial-match.branch Lno Args OtherArgs F K KTy Vars _ R1 :- std.do! [ coq.mk-app K Vars KArgs, coq.safe-dest-app KTy _ KTyArgs, std.drop Lno KTyArgs IdxVals, std.map2 Args IdxVals (x\y\r\ r = copy x y) Subst, (R = let `K` KTy KArgs x\ {coq.mk-app F {std.append OtherArgs [x]}}), Subst => copy R R1, ]. % prove H G P finds a P : H => G pred prove i:term, i:term, o:term. pred cross i:term. % prove-arg AppliedHyp AppliedGoal Argument ProofAppliedHyp Proof. pred prove-arg i:term, i:term, i:term, i:term, o:term. prove-arg X X _ P P :- !. prove-arg (app [H|Hs]) (app[G|Gs]) X PHX PGX :- std.appendR HArgs [X] Hs, coq.mk-app H HArgs Hyp, std.appendR GArgs [X] Gs, coq.mk-app G GArgs Goal, prove Hyp Goal Proof, coq.mk-app Proof [X,PHX] PGX. prove-arg (prod _ X x\ prod _ (PX x) (H x)) (prod _ _ y\ prod _ (PX y) (G y)) A PA (fun `x` X x\ fun `px` (PX x) (Proof x)) :- pi x px\ prove-arg (H x px) (G x px) {coq.mk-app A [x]} {coq.mk-app PA [x,px]} (Proof x px). pred prove-args i:list term, i:list term, o:list term. prove-args [] [] []. prove-args [X,Pr|Args] [_,PX|ArgsT] [X,Proof|QArgs] :- coq.safe-dest-app PX HD _, cross HD, !, copy PX Goal, (prove-arg PX Goal X Pr Proof ; Proof = Pr), !, prove-args Args ArgsT QArgs. prove-args [X|Args] [PX|ArgsT] [ProofX|QArgs] :- copy PX Goal, prove PX Goal Proof, !, coq.mk-app Proof [X] ProofX, prove-args Args ArgsT QArgs. prove-args [X|Args] [_|ArgsT] [X|QArgs] :- prove-args Args ArgsT QArgs. }coq-elpi-1.19.3/apps/derive/elpi/projK.elpi000066400000000000000000000126571451177652200204550ustar00rootroot00000000000000/* Derive a function "projnK t -> x" iif t is "K ..x.." */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{append, any->string, zip, map, map2, nth, do!, assert!, flatten}. % TODO: instead of using a context and integers one could % generate the product for the projected argument and use via subst-prod % rather than using copy like crazy namespace derive.projK { pred exT-close i:list int, i:list (pair term term), i:list term, i:term, i:term, o:term, o:term. exT-close [] _ _ T Ty T Ty1 :- copy Ty Ty1. exT-close [N|Mask] Ctx Args T Ty {{ @existT lp:S lp:P lp:A lp:R1 }} {{ @sigT lp:S lp:P }} :- nth N Ctx (pr X TX), copy TX S, P = fun {coq.name-suffix `i` N} S B, nth N Args A, (pi x\ copy X x => exT-close Mask Ctx Args T Ty (R x) (B x)), R1 = R A. pred sigT-close i:list int, i:list (pair term term), i:term, o:term. sigT-close [] _ Ty Ty1 :- copy Ty Ty1. sigT-close [N|Mask] Ctx Ty {{ @sigT lp:S lp:P }} :- nth N Ctx (pr X TX), copy TX S, P = fun {coq.name-suffix `i` N} S B, pi x\ copy X x => sigT-close Mask Ctx Ty (B x). pred body-branch i:int, i:constructor, i:term, i:term, i:list term, i:list term, o:term. body-branch J K K1 _ VS TS R :- default-output J Mask DfltCtx Dflt DfltTy, if (coq.safe-dest-app K1 (global (indc K)) _) (nth J VS X, nth J TS XT, zip VS TS Ctx, Args = VS) (X = Dflt, XT = DfltTy, Ctx = DfltCtx, map DfltCtx fst Args), exT-close Mask Ctx Args X XT R _RT. pred body-ty i:int, i:term, i:list term, i:list term, o:term. body-ty J _ _ _ SigT :- default-output J Mask Args _ T, sigT-close Mask Args T SigT. pred occurs-list i:list (pair term term), i:int, i:term, o:list int. occurs-list [] _ _ []. occurs-list [pr X _|XS] I T [I|IS] :- occurs X T, !, J is I + 1, occurs-list XS J T IS. occurs-list [_|XS] I T IS :- J is I + 1, occurs-list XS J T IS. pred mask-for i:term, i:list (pair term term), o:list int. mask-for T Args Mask :- occurs-list Args 0 T Mask. pred default-output i:int, % gather infos to generate the match o:list int, % mask: the position of the arguments that occur in the type % of the projected one o:list (pair term term), % a context (term,type) of default values o:term, % the default value for the projected argument o:term. % its type pred body-default % makes lambdas for all default arguments + the projected i:term, % constructor type (begin processed) i:int, % current argument i:int, % argument to project i:term, % inductive type applied to parameters and indexes i:list (pair term term), % variables for default arguments i:constructor, % constructor to project o:term. body-default (prod N T F) J OJ IT Args K (fun N T B) :- !, mask-for T Args Mask, J1 is J + 1, pi x\ sigma Def\ if (J = OJ) (Def = [default-output J Mask Args x T]) (Def = []), Def => body-default (F x) J1 OJ IT {append Args [pr x T]} K (B x). body-default X J OJ IT Args K F :- whd1 X X1, !, body-default X1 J OJ IT Args K F. body-default _ _ J IT _ K (fun `i` IT B) :- !, pi i\ coq.build-match i IT (body-ty J) (body-branch J K) (B i). pred body-param % makes lambdas for all parameters and indexes i:term, % arity of the inductive type i:term, % type of the constructor to project i:term, % inductive type applied to the arity processed so far i:int, % number of Parameters left to process i:int, % argument to project i:constructor, % constructor to project o:term. body-param (sort _) KTy IT 0 J K R :- !, body-default KTy 0 J IT [] K R. body-param (prod N T F) KTy IT 0 J K (fun N T B) :- !, pi x\ body-param (F x) KTy {coq.mk-app IT [x]} 0 J K (B x). body-param (prod N T F) (prod _ _ FK) IT Pno J K (fun N T B) :- !, Pno1 is Pno - 1, pi x\ body-param (F x) (FK x) {coq.mk-app IT [x]} Pno1 J K (B x). body-param (prod _ _ _ as X) KTy IT N J K R :- whd1 KTy KTy1, !, body-param X KTy1 IT N J K R. body-param X (prod _ _ _ as KTy) IT N J K R :- whd1 X X1, !, body-param X1 KTy IT N J K R. body-param X KTy IT N J K R :- whd1 X X1, whd1 KTy KTy1, !, body-param X1 KTy1 IT N J K R. % --------------------------------------------------------------------- pred allK-projs i:string, i:int, i:int, i:int, i:term, i:term, i:constructor, i:term, o:list prop. allK-projs _ J J _ _ _ _ _ [] :- !. allK-projs Prefix J JN Paramsno Arity IT K KTy Clauses :- do! [ body-param Arity KTy IT Paramsno J K RSkel, J1 is J + 1, Name is Prefix ^ {coq.gref->id (indc K)} ^ {any->string J1}, if (coq.elaborate-skeleton RSkel TyR R ok) (@dropunivs! => coq.env.add-const Name R TyR _ P, Clause = (projK-db K J1 (global (const P)) :- !), coq.elpi.accumulate _ "derive.projK.db" (clause _ (before "projK-db:fail") Clause), Clauses = [Clause|ClausesRest]) (coq.say "skip" Name R, Clauses = ClausesRest), allK-projs Prefix J1 JN Paramsno Arity IT K KTy ClausesRest ]. pred for-K i:string, i:int, i:term, i:term, i:constructor, i:term, o:list prop. for-K Prefix Paramsno Arity IT K KT Clauses :- do! [ coq.count-prods KT N, Argsno is N - Paramsno, allK-projs Prefix 0 Argsno Paramsno Arity IT K KT Clauses ]. pred main i:inductive, i:string, o:list prop. main GR Prefix Clauses :- do! [ T = global (indt GR), coq.env.indt GR _ Paramsno _ Arity Kn Kt, map2 Kn Kt (for-K Prefix Paramsno Arity T) ClausesList, flatten ClausesList Clauses ]. } coq-elpi-1.19.3/apps/derive/elpi/tag.elpi000066400000000000000000000045111451177652200201310ustar00rootroot00000000000000/* constructor name first class representation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % not necessary, but gives pointers to relevant files shorten std.{ fold-map , do! , last }. % from elpi-builtin.elpi shorten coq.{ build-match , bind-ind-arity }. % from coq-lib.elpi shorten coq.{ elaborate-skeleton }. % from coq-builtin.elpi % if we load this file together with others files, we avoid chlashes namespace derive.tag { % we return the clauses for the tag.db since we may need them right away % if we run other derivations immediately pred main i:inductive, i:string, o:list prop. main I Prefix CL :- do! [ % build fun params (x : I params) => ... do-match ... coq.env.indt I _ _ _ Arity _ _, bind-ind-arity (global (indt I)) Arity do-match BodyR, % typecheck (and infer univ constraints) std.assert-ok! (elaborate-skeleton BodyR Ty Body) "derive.tag generates illtyped code", % save constant coq.ensure-fresh-global-id (Prefix ^ "tag") Name, coq.env.add-const Name Body Ty ff C, % store in the DB the tag function, so that other Elpi commands can find it CL = [tag-for I C], std.forall CL (x\ coq.elpi.accumulate _ "derive.tag.db" (clause _ _ x)), ]. % We build the match with dummy branches (you get the lambdas for the % arguments of constructors, then Prop). Then we put the right number in place. pred do-match i:term, i:list term, i:list term, o:term. do-match _ Vars Tys (match X Rty BL1) :- do! [ last Vars X, % the last variable is the one for the inductive type last Tys XTy, build-match X XTy do-rty do-dummy-branch (match X Rty BL), fold-map BL {{ 1 }} do-branch BL1 _, ]. % builds the return clause of the match pred do-rty i:term, i:list term,i:list term, o:term. do-rty _ _ _ {{ lib:elpi.derive.positive }}. % build each branch pred do-dummy-branch i:term, i:term, i:list term, i:list term, o:term. do-dummy-branch _ _ _ _ {{ Prop }}. % dummy % [do-branch InTerm Acc NewTem NewAcc] descends into a branch and puts Acc % in place of the dummy pred do-branch i:term, i:term, o:term, o:term. do-branch {{ Prop }} X X Y :- coq.reduction.lazy.norm {{ lp:X + 1 }} Y. do-branch (fun N T F) X (fun N T R) Y :- @pi-decl N T x\ do-branch (F x) X (R x) Y. }coq-elpi-1.19.3/apps/derive/examples/000077500000000000000000000000001451177652200173675ustar00rootroot00000000000000coq-elpi-1.19.3/apps/derive/examples/readme.v000066400000000000000000000012601451177652200210120ustar00rootroot00000000000000(* README *) From elpi.apps Require Import derive.std. derive Inductive peano := Zero | Succ (p : peano). (* Bug 8.16: About peano.peano.*) (* Notation peano := peano.peano *) Print peano.peano. (* Inductive peano : Type := Zero : peano | Succ : peano -> peano *) Eval compute in peano.eqb Zero (Succ Zero). (* = false : bool *) About peano.eqb_OK. (* peano.eqb_OK : forall x1 x2 : peano, Bool.reflect (x1 = x2) (peano.eqb x1 x2) peano.eqb_OK is not universe polymorphic Arguments peano.eqb_OK x1 x2 peano.eqb_OK is opaque *) #[verbose] derive Nat.add. Check is_add. (* : forall n : nat, is_nat n -> forall m : nat, is_nat m -> is_nat (n + m) *)coq-elpi-1.19.3/apps/derive/examples/usage.v000066400000000000000000000054311451177652200206650ustar00rootroot00000000000000(** This example shows how to use derive *) From Coq Require Import Bool. From elpi.apps Require Import derive.std. Set Uniform Inductive Parameters. (** The best way to call derive is to prefix an Inductive declaration. *) derive Inductive tickle A := stop | more : A -> tickle -> tickle. (** The command is elaborated to something like: Module tickle. Inductive tickle A := stop | more : A -> tickle -> tickle. derive tickle. End tickle. Notation tickle := tickle.tickle. Notation stop := tickle.stop. Notation more := tickle.more. *) Check more : forall A, A -> tickle A -> tickle A. (** Some goodies *) Check tickle.eqb : (* eq test *) forall A, (A -> A -> bool) -> tickle A -> tickle A -> bool. Check tickle.eqb_OK : (* eq test correctness proof *) forall A f, (forall x y, reflect (x = y) (f x y)) -> forall x y, reflect (x = y) (tickle.eqb A f x y). Check tickle.map : (* map the container *) forall A B, (A -> B) -> tickle A -> tickle B. Check tickle.tickle_R : (* relator (binary parametricity translation) *) forall A B, (A -> B -> Type) -> tickle A -> tickle B -> Type. (** This is a tricky case, since you need a good induction principle for the nested occurrence of tickle. #[verbose] prints all the derivations being run *) #[verbose] derive Inductive rtree A := Leaf (a : A) | Node (l : tickle rtree). Check rtree.induction : (* this is the key *) forall A PA P, (forall a, PA a -> P (Leaf A a)) -> (forall l, tickle.is_tickle (rtree A) P l -> P (Node A l)) -> forall x, rtree.is_rtree A PA x -> P x. (** You can also select which derivations you like *) #[verbose, only(lens_laws, eqb)] derive Record Box A := { contents : A; tag : nat }. Check Box.eqb : forall A, (A -> A -> bool) -> Box A -> Box A -> bool. Import lens. Check @Box._tag : (* the Lens for the second field (A is implicit) *) forall A, Lens (Box A) (Box A) nat nat. Check Box._tag_set_set : (* a Lens law *) forall A (r : Box A) y x, set Box._tag x (set Box._tag y r) = set Box._tag x r. Check Box._tag_contents_exchange : (* another one *) forall A (r : Box A) x y, set Box._tag x (set Box._contents y r) = set Box._contents y (set Box._tag x r). (** Finally, one can derive an existing inductive type. Generated constants are prefixed with nat_ but won't be in the right place, which is where the type is defined. This means that two users may run derive for the same type in different files, leading to duplication. *) derive nat. Check nat_eqb_OK : forall x y, reflect (x = y) (nat_eqb x y). (** Once can also run derive recursively, but this has the same bad effect, all generated concepts will be out of place *) Inductive a := A. Inductive b := B : a -> b. #[recursive, only(eqbOK)] derive b. Check a_eqb. Check b_eqb. coq-elpi-1.19.3/apps/derive/tests/000077500000000000000000000000001451177652200167135ustar00rootroot00000000000000coq-elpi-1.19.3/apps/derive/tests/test_bcongr.v000066400000000000000000000071511451177652200214170ustar00rootroot00000000000000From elpi.apps Require Import derive.bcongr. From elpi.apps Require Import test_derive_stdlib test_projK. Import test_derive_stdlib.Coverage. Import test_projK.Coverage. Module Coverage. Elpi derive.bcongr empty. Elpi derive.bcongr unit. Elpi derive.bcongr peano. Elpi derive.bcongr option. Elpi derive.bcongr pair. Elpi derive.bcongr seq. Elpi derive.bcongr box_peano. Elpi derive.bcongr rose. Elpi derive.bcongr rose_p. Elpi derive.bcongr rose_o. Elpi derive.bcongr nest. Elpi derive.bcongr w. Fail Elpi derive.bcongr vect. Fail Elpi derive.bcongr dyn. Elpi derive.bcongr zeta. Elpi derive.bcongr beta. Fail Elpi derive.bcongr iota. (* Elpi derive.bcongr large. *) Elpi derive.bcongr prim_int. Elpi derive.bcongr prim_float. Elpi derive.bcongr fo_record. Elpi derive.bcongr pa_record. Elpi derive.bcongr pr_record. Fail Elpi derive.bcongr dep_record. Elpi derive.bcongr enum. Elpi derive.bcongr eq. Elpi derive.bcongr bool. Fail Elpi derive.bcongr sigma_bool. Fail Elpi derive.bcongr val. Fail Elpi derive.bcongr ord. End Coverage. Import Coverage. Check unit_bcongr_tt : reflect (tt = tt) true. Check peano_bcongr_Zero : reflect (Zero = Zero) true. Check peano_bcongr_Succ : forall x y b, reflect (x = y) b -> reflect (Succ x = Succ y) b. Check option_bcongr_None : forall A, reflect (None A = None A) true. Check option_bcongr_Some : forall A x y b, reflect (x = y) b -> reflect (Some A x = Some A y) b. Check pair_bcongr_Comma : forall A B x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Comma A B x1 y1 = Comma A B x2 y2) (b1 && b2). Check seq_bcongr_Nil : forall A, reflect (Nil A = Nil A) true. Check seq_bcongr_Cons : forall A x y b1, reflect (x = y) b1 -> forall xs ys b2, reflect (xs = ys) b2 -> reflect (Cons A x xs = Cons A y ys) (b1 && b2). Check rose_bcongr_Leaf : forall A x y b, reflect (x = y) b -> reflect (Leaf A x = Leaf A y) b. Check rose_bcongr_Node : forall A l1 l2 b, reflect (l1 = l2) b -> reflect (Node A l1 = Node A l2) b. Check nest_bcongr_NilN : forall A, reflect (NilN A = NilN A) true. Check nest_bcongr_ConsN : forall A x y b1, reflect (x = y) b1 -> forall xs ys b2, reflect (xs = ys) b2 -> reflect (ConsN A x xs = ConsN A y ys) (b1 && b2). Check w_bcongr_via : forall A f g b, reflect (f = g) b -> reflect (via A f = via A g) b. Fail Check vect_bcongr_VNil. Fail Check vect_bcongr_VCons. Fail Check dyn_bcongr_box. Check zeta_bcongr_Envelope : forall A x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Envelope A x1 y1 = Envelope A x2 y2) (b1 && b2). Check beta_bcongr_Redex : forall A x y b, reflect (x = y) b -> reflect (Redex A x = Redex A y) b. Fail Check iota_bcongr_Why. Check prim_int_bcongr_PI : forall x y b, reflect (x = y) b -> reflect (PI x = PI y) b. Check prim_float_bcongr_PF : forall x y b, reflect (x = y) b -> reflect (PF x = PF y) b. (* Check large_bcongr_K1. *) Check fo_record_bcongr_Build_fo_record : forall x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Build_fo_record x1 y1 = Build_fo_record x2 y2) (b1 && b2). Check pa_record_bcongr_Build_pa_record : forall A, forall x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Build_pa_record A x1 y1 = Build_pa_record A x2 y2) (b1 && b2). Check pr_record_bcongr_Build_pr_record : forall A, forall x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Build_pr_record A x1 y1 = Build_pr_record A x2 y2) (b1 && b2). Check enum_bcongr_E1 : reflect (E1 = E1) true. Check enum_bcongr_E2 : reflect (E2 = E2) true. Check enum_bcongr_E3 : reflect (E3 = E3) true. coq-elpi-1.19.3/apps/derive/tests/test_derive.v000066400000000000000000000167101451177652200214240ustar00rootroot00000000000000From elpi.apps Require Import derive.std derive.legacy derive.experimental. From elpi.apps Require Import test_derive_stdlib. Elpi derive Coverage.empty. Elpi derive Coverage.unit. Elpi derive Coverage.peano. Elpi derive Coverage.option. Elpi derive Coverage.pair. Elpi derive Coverage.seq. Elpi derive Coverage.box_peano. Elpi derive Coverage.rose. Elpi derive Coverage.rose_p. Elpi derive Coverage.rose_o. Elpi derive Coverage.nest. Elpi derive Coverage.w. Elpi derive Coverage.vect. Elpi derive Coverage.dyn. Fail Elpi derive Coverage.zeta. Elpi derive Coverage.beta. Elpi derive Coverage.iota. (* Elpi derive Coverage.large. search slow *) Elpi derive Coverage.prim_int. Elpi derive Coverage.fo_record. Elpi derive Coverage.pa_record. Elpi derive Coverage.pr_record. Elpi derive Coverage.dep_record. Elpi derive Coverage.enum. (* ---------------------------------------------------- *) Elpi derive bool. #[verbose] Elpi derive nat. Check nat_eqb : nat -> nat -> bool. Check is_nat : nat -> Type. Check is_nat_inhab : forall x, is_nat x. Check is_nat_functor : forall x, is_nat x -> is_nat x. Check nat_induction : forall P, P 0 -> (forall n, P n -> P (S n)) -> forall x, is_nat x -> P x. Check nat_tag : nat -> Numbers.BinNums.positive. Check nat_fields_t : Numbers.BinNums.positive -> Type. Check nat_fields : forall (n:nat), nat_fields_t (nat_tag n). Check nat_construct : forall (p: Numbers.BinNums.positive), nat_fields_t p -> option nat. Check nat_constructP : forall (n:nat), nat_construct (nat_tag n) (nat_fields n) = Some n. Check nat_eqb : nat -> nat -> bool. Check nat_eqb_correct. Check nat_eqb_refl. (* ---------------------------------------------------- *) Elpi derive.param1 andb. (* Prelude: Elpi derive list. *) Check list_map : forall A B, (A -> B) -> list A -> list B. Check is_nil : forall A P, is_list A P (@nil A). Check is_cons : forall A P x (Px : P x) tl (Ptl : is_list A P tl), is_list A P (cons x tl). Check is_list_functor : forall A P Q, (forall x, P x -> Q x) -> forall l, is_list A P l -> is_list A Q l. Check list_induction : forall A PA P, P nil -> (forall x, PA x -> forall xs, P xs -> P (cons x xs)) -> forall l, is_list A PA l -> P l. Check list_tag : forall A, list A -> Numbers.BinNums.positive. Check list_fields_t : (Type -> Numbers.BinNums.positive -> Type). Check list_fields : forall (A:Type) (l:list A), list_fields_t A (list_tag A l). Check list_construct : forall (A:Type) (p: Numbers.BinNums.positive), list_fields_t A p -> option (list A). Check list_constructP : forall (A:Type) (l:list A), list_construct A (list_tag A l) (list_fields A l) = Some l. Check list_eqb : forall A, (A -> A -> bool) -> list A -> list A -> bool. Check list_eqb_correct. Check list_eqb_refl. (* ---------------------------------------------------- *) Require Vector. Elpi Print derive. #[only(eqOK), verbose] derive nat. Module Vector. derive Vector.t. End Vector. Check Vector.t_eq : forall A, (A -> A -> bool) -> forall n, Vector.t A n -> Vector.t A n -> bool. Check Vector.t_isk_nil : forall A n, Vector.t A n -> bool. Check Vector.t_isk_cons : forall A n, Vector.t A n -> bool. Check Vector.t_map : forall A B, (A -> B) -> forall n, Vector.t A n -> Vector.t B n. Check Vector.t_getk_cons1 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> A. Check Vector.t_getk_cons2 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> nat. Check Vector.t_getk_cons3 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> { k : nat & Vector.t A k}. Check Vector.is_t : forall A, (A -> Type) -> forall n, is_nat n -> Vector.t A n -> Type. Check Vector.is_nil : forall A (PA : A -> Type), Vector.is_t A PA 0 is_O (Vector.nil A). Check Vector.is_cons : forall A (PA : A -> Type) (a : A), PA a -> forall n (Pn : is_nat n) (H : Vector.t A n), Vector.is_t A PA n Pn H -> Vector.is_t A PA (S n) (is_S n Pn) (Vector.cons A a n H). Check Vector.is_t_functor : forall A PA QA (H : forall x, PA x -> QA x), forall n nR v, Vector.is_t A PA n nR v -> Vector.is_t A QA n nR v. Check Vector.t_induction : forall A PA (P : forall n, is_nat n -> Vector.t A n -> Type), P 0 is_O (Vector.nil A) -> (forall a, PA a -> forall m mR, forall (v : Vector.t A m), P m mR v -> P (S m) (is_S m mR) (Vector.cons A a m v)) -> forall n nR v, Vector.is_t A PA n nR v -> P n nR v. Check Vector.t_tag : forall A i, Vector.t A i -> Numbers.BinNums.positive. Fail Check Vector.t_fields_t : (Type -> Numbers.BinNums.positive -> Type). Fail Check Vector.t_fields : forall (A:Type) (n:nat) (l:Vector.t A n), Vector.t_fields_t A (Vector.t_tag A l). Fail Check Vector.t_construct : forall (A:Type) (p: Numbers.BinNums.positive), Vector.t_fields_t A p -> option (Vector.t A). Fail Check Vector.t_constructP : forall (A:Type) (l:Vector.t A), Vector.t_construct A (Vector.t_tag A l) (Vector.t_fields A l) = Some l. Fail Check Vector.t_eqb : forall A, (A -> A -> bool) -> forall n, Vector.t A n -> Vector.t A n -> bool. (* ---------------------------------------------------- *) Inductive W A := B (f : A -> W). Elpi derive W. (* Not implemented yet :-/ *) Fail Check W_induction : forall A (P : W A -> Type), (forall f, (forall x, UnitPred A x -> P (f x)) -> P (B A f)) -> forall x, P x. Check W_tag : forall A, W A -> Numbers.BinNums.positive. Fail Check W_fields_t : (Type -> Numbers.BinNums.positive -> Type). Fail Check W_fields : forall (A:Type) (l:W A), W_fields_t A (W_tag A l). Fail Check W_construct : forall (A:Type) (p: Numbers.BinNums.positive), W_fields_t A p -> option (W A). Fail Check W_constructP : forall (A:Type) (l:W A), W_construct A (W_tag A l) (W_fields A l) = Some l. (* ---------------------------------------------------- *) Inductive horror A (a : A) : forall T, T -> Type := K W w (k : horror W w) : horror W w. Fail #[only(eqbOK)] derive horror. (* TODO add test for fields? *) (* ---------------------------------------------------- *) Inductive rtree A : Type := Leaf (n : A) | Node (l : list rtree). Module XXX. Elpi derive rtree. End XXX. Fail Check XXX.rtree_is_rtree_map. Check XXX.rtree_tag : forall A, rtree A -> Numbers.BinNums.positive. Check XXX.rtree_fields_t : (Type -> Numbers.BinNums.positive -> Type). Check XXX.rtree_fields : forall (A:Type) (l:rtree A), XXX.rtree_fields_t A (XXX.rtree_tag A l). Check XXX.rtree_construct : forall (A:Type) (p: Numbers.BinNums.positive), XXX.rtree_fields_t A p -> option (rtree A). Check XXX.rtree_constructP : forall (A:Type) (l:rtree A), XXX.rtree_construct A (XXX.rtree_tag A l) (XXX.rtree_fields A l) = Some l. Check XXX.rtree_eqb : forall (A:Type), (A -> A -> bool) -> rtree A -> rtree A -> bool. (* bug #270 *) derive Inductive triv : Coverage.unit -> Prop := | one t : triv t | more x : triv x. Check triv.induction : forall P : (forall H : Coverage.unit, is_unit H -> triv H -> Prop), (forall t (Pt : is_unit t), P t Pt (one t)) -> (forall x (Px : is_unit x), P x Px (more x)) -> forall u (p : is_unit u) (s : triv u), triv.is_triv u p s -> P u p s. (* #271 *) derive Inductive RoseTree : Type := | RT_ctr (branches : list RoseTree). Elpi derive.param1 is_list. derive Inductive Pred : RoseTree -> Type := | Pred_ctr branches : is_list _ Pred branches -> Pred (RT_ctr branches). Check Pred.Pred_to_Predinv : forall T, Pred T -> Pred.Predinv T. (* #286 *) Module Import derive_container. Unset Implicit Arguments. derive Inductive wimpls {A} `{rtree A} := Kwi (x:A) (y : x = x) : wimpls | Kwa. End derive_container. About wimpls.wimpls. About wimpls.Kwi. Check Kwi _ (refl_equal 3). From Coq Require Ascii. #[only(param2)] derive Ascii.ascii. coq-elpi-1.19.3/apps/derive/tests/test_derive_stdlib.v000066400000000000000000000143621451177652200227660ustar00rootroot00000000000000(* Some standard data types using different features *) From Coq Require Uint63. From Coq Require Floats. Module Coverage. Inductive empty := . Inductive unit := tt. Inductive peano := Zero | Succ (n : peano). Inductive option A := None | Some (_ : A). Inductive pair A B := Comma (a : A) (b : B). Inductive seq A := Nil | Cons (x : A) (xs : seq A). Inductive box_peano := Box (n:peano). Inductive rose (A : Type) := Leaf (a : A) | Node (sib : seq (rose A)). Inductive rose_p (A B : Type) := Leafp (p : pair A B) | Nodep (sib : pair (rose_p A B) (rose_p A B)). Inductive rose_o (A : Type) := Leafo (a : A) | Nodeo (x: pair (rose A) (rose A)) (sib : option (seq (rose A))). Inductive nest A := NilN | ConsN (x : A) (xs : nest (pair A A)). Fail Inductive bush A := BNil | BCons (x : A) (xs : bush (bush A)). Inductive w A := via (f : A -> w A). Inductive vect A : peano -> Type := VNil : vect A Zero | VCons (x : A) n (xs : vect A n) : vect A (Succ n). Inductive dyn := box (T : Type) (t : T). Inductive zeta Sender (Receiver := Sender) := Envelope (a : Sender) (ReplyTo := a) (c : Receiver). Inductive beta (A : (fun x : Type => x) Type) := Redex (a : (fun x : Type => x) A). Inductive iota := Why n (a : match n in peano return Type with Zero => peano | Succ _ => unit end). Inductive large := | K1 (_ : unit) | K2 (_ : unit) (_ : unit) | K3 (_ : unit) (_ : unit) (_ : unit) | K4 (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K5 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K6 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K7 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K8 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K9 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K10(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K11(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K12(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K13(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K14(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K15(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K16(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K17(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K18(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K19(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K20(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K21(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K22(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K23(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K24(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K25(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K26(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit). Inductive prim_int := PI (i : Uint63.int). Inductive prim_float := PF (f : PrimFloat.float). Record fo_record := { f1 : peano; f2 : unit; }. Record pa_record A := { f3 : peano; f4 : A; }. Set Primitive Projections. Record pr_record A := { pf3 : peano; pf4 : A; }. Unset Primitive Projections. Record dep_record := { f5 : peano; f6 : vect unit f5; }. Variant enum := E1 | E2 | E3. Definition is_zero (n:peano) : bool := match n with | Zero => true | _ => false end. Record sigma_bool := { depn : peano; depeq : is_zero depn = true }. Fixpoint is_leq (n m:peano) : bool := match n, m with | Zero, _ => true | Succ n, Succ m => is_leq n m | _, _ => false end. Inductive ord (p : peano) := mkOrd (n : peano) (l : is_leq n p = true). Inductive ord2 (p : peano) := mkOrd2 (o1 o2 : ord p). Inductive val := V (p : peano) (o : ord p). (* to make the coverage cound correct Inductive eq := ... Inductive bool := ... we don't have a copy here because some DBs have special rules*) Definition alias := seq peano. End Coverage. coq-elpi-1.19.3/apps/derive/tests/test_derive_vector.v000066400000000000000000000105561451177652200230100ustar00rootroot00000000000000From elpi.apps Require Import derive. From elpi.apps Require Import test_derive_stdlib. Elpi derive.projK Coverage.vect. Check projVCons3 : forall A n, A -> forall m, Coverage.vect A m -> Coverage.vect A n -> {i1 : Coverage.peano & Coverage.vect A i1}. (* Elpi derive.bcongr Coverage.vect (* FIXME partial *). *) From mathcomp Require Import all_ssreflect. Elpi derive.eq Coverage.peano. Axiom peano_eqP : forall a b : Coverage.peano, reflect (a = b) (peano_eq a b). Print Equality.mixin_of. Canonical peano_eqMixin := Equality.Mixin peano_eqP. Canonical peano_eqType := Equality.Pack peano_eqMixin Coverage.peano. Lemma bcongr_VNil A : reflect (existT _ _ (Coverage.VNil A) = existT _ _ (Coverage.VNil A)) true. Proof. by constructor. Qed. Lemma bcongr_VCons : forall A, forall (a1 a2 : A) b1, reflect (a1 = a2) b1 -> forall (n1 n2 : Coverage.peano) b2, reflect (n1 = n2) b2 -> forall (v1 : Coverage.vect A n1) (v2 : Coverage.vect A n2) b3, reflect (existT _ n1 v1 = existT _ n2 v2) b3 -> reflect (existT _ _ (Coverage.VCons A a1 n1 v1) = existT _ _ (Coverage.VCons A a2 n2 v2)) [&& b1 , b2 & b3]. Proof. move=> A a1 a2 b1 [->|abs1] n1 n2 b2 [E2|abs2]; try case: _ / E2 => v1 v2 b3 [E3|abs3]; constructor. by have /= <- := (projT2_eq E3); rewrite [projT1_eq _]eq_axiomK /=. by move=> abs; apply: abs3; have /= := (projT2_eq abs); rewrite [projT1_eq _]eq_axiomK /= => [= -> ]. by move=> abs; apply: abs2; have [= -> ] := (projT1_eq abs). by move=> abs; apply: abs1; have /= := (projT2_eq abs); rewrite [projT1_eq _]eq_axiomK /= => [= -> ]. by move=> abs; apply: abs1; have /= := (projT2_eq abs); rewrite [projT1_eq _]eq_axiomK /= => [= -> ]. by move=> abs; apply: abs2; have [= -> ] := (projT1_eq abs). Qed. Elpi derive.eq Coverage.vect. Fixpoint vect_eq_sig A f (v1 v2 : {n & Coverage.vect A n}) : bool := let: existT n1 v1 := v1 in let: existT n2 v2 := v2 in if (peano_eqP n1 n2) is ReflectT e then vect_eq A f n2 (match e with erefl => v1 end) v2 else false. Elpi derive.param1 Coverage.peano. Elpi derive.param1 Coverage.vect. Elpi derive.induction Coverage.peano. Elpi derive.induction Coverage.vect. Elpi derive.projK sigT. Lemma bridge A f n v : axiom {n & Coverage.vect A n} (vect_eq_sig A f) (existT _ n v) -> axiom (Coverage.vect A n) (vect_eq A f n) v. Proof. move=> E y; move: (E (existT _ n y)) => /= {E}. case: peano_eqP => // p. rewrite [p]eq_axiomK /=. case=> [H|abs]; constructor. by move: (projT2_eq H); rewrite [projT1_eq _]eq_axiomK /= => <-. by move=> E; apply: abs; rewrite E. Qed. Lemma bridge2 A f n v : axiom (Coverage.vect A n) (vect_eq A f n) v -> axiom {n & Coverage.vect A n} (vect_eq_sig A f) (existT _ n v). Proof. move=> E [m w]; rewrite /vect_eq_sig /=. case: peano_eqP => //= e. case: _ / e w => /= w. case: (E w) => [->|abs]; constructor => // H. by apply: abs; move: (projT2_eq H); rewrite [projT1_eq _]eq_axiomK /= => <-. constructor=> abs; apply: e. apply: projT1_eq abs. Qed. Lemma axiom_VNil : forall (A : Type) (f : A -> A -> bool) x, axiom_at {n & Coverage.vect A n} (vect_eq_sig A f) (existT _ Coverage.Zero (Coverage.VNil A)) x. Proof. move=> A f [n1 [|*]]; rewrite /axiom_at /vect_eq_sig /=; case: peano_eqP => //= e. rewrite [e]eq_axiomK /=; constructor; exact: bcongr_VNil. by constructor=> abs; move: (projT1_eq abs) => /=. Qed. Lemma axiom_VCons : forall A f a n xs, axiom A f a -> axiom {n : Coverage.peano & Coverage.vect A n} (vect_eq_sig A f) (existT [eta Coverage.vect A] n xs) -> axiom {n0 : Coverage.peano & Coverage.vect A n0} (vect_eq_sig A f) (existT [eta Coverage.vect A] (Coverage.Succ n) (Coverage.VCons A a n xs)). Proof. move=> A f a n v Hf H [m [|b w]]; rewrite /vect_eq_sig; case: peano_eqP => //= e. by constructor=> abs; apply: e; move: (projT1_eq abs). move: {-}(e) => [= e1 ]. case: _ / e1 in e *. rewrite [e]eq_axiomK /= => ys. apply: bcongr_VCons. apply: Hf. apply: eqP. by have /= := H (existT _ n ys); case: peano_eqP => // p; rewrite [p]eq_axiomK /=. by move=> tl; constructor=> abs; apply: e; apply: projT1_eq abs. Qed. Lemma ok : forall (a : Type) (fa : a -> a -> bool) n pn (s1 : Coverage.vect a n), vectR a (axiom a fa) n pn s1 -> axiom (Coverage.vect a n) (vect_eq a fa n) s1. Proof. move=> A f; apply: vect_induction. apply: bridge; exact: axiom_VNil. move=> a Hf n nR xs /bridge2 IH; apply/bridge; exact: axiom_VCons. Qed. coq-elpi-1.19.3/apps/derive/tests/test_eq.v000066400000000000000000000035601451177652200205520ustar00rootroot00000000000000From elpi.apps Require Import test_derive_stdlib derive.eq. Import test_derive_stdlib.Coverage. Module Coverage. Elpi derive.eq empty. Elpi derive.eq unit. Elpi derive.eq peano. Elpi derive.eq option. Elpi derive.eq pair. Elpi derive.eq seq. Elpi derive.eq box_peano. Elpi derive.eq rose. Elpi derive.eq rose_p. Elpi derive.eq rose_o. Fail Elpi derive.eq nest. Fail Elpi derive.eq w. (* expected *) Elpi derive.eq vect. Fail Elpi derive.eq dyn. (* expected *) Elpi derive.eq zeta. Elpi derive.eq beta. Fail Elpi derive.eq iota. Elpi derive.eq large. Elpi derive.eq prim_int. Elpi derive.eq prim_float. Elpi derive.eq fo_record. Elpi derive.eq pa_record. Elpi derive.eq pr_record. Fail Elpi derive.eq dep_record. Elpi derive.eq enum. Fail Elpi derive.eq eq. Elpi derive.eq bool. Fail Elpi derive.eq sigma_bool. Fail Elpi derive.eq ord. Fail Elpi derive.eq val. End Coverage. Import Coverage. Notation eq_test T := (T -> T -> bool). Check empty_eq : eq_test empty. Check unit_eq : eq_test unit. Check peano_eq : eq_test peano. Check option_eq : forall A, eq_test A -> eq_test (option A). Check pair_eq : forall A, eq_test A -> forall B, eq_test B -> eq_test (pair A B). Check seq_eq : forall A, eq_test A -> eq_test (seq A). Check rose_eq : forall A, eq_test A -> eq_test (rose A). Fail Check nest_eq. Fail Check w_eq. Check vect_eq : forall A, eq_test A -> forall i, eq_test (vect A i). Fail Check dyn_eq. Check zeta_eq : forall A, eq_test A -> eq_test (zeta A). Check beta_eq : forall A, eq_test A -> eq_test (beta A). Fail Check iota_eq : eq_test iota. Check large_eq : eq_test large. Check prim_int_eq : eq_test prim_int. Check prim_float_eq : eq_test prim_float. Check fo_record_eq : eq_test fo_record. Check pa_record_eq : forall A, eq_test A -> eq_test (pa_record A). Check pr_record_eq : forall A, eq_test A -> eq_test (pr_record A). Check enum_eq : eq_test enum. coq-elpi-1.19.3/apps/derive/tests/test_eqK.v000066400000000000000000000057061451177652200206710ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive.eqK. From elpi.apps.derive.tests Require Import test_derive_stdlib test_isK test_projK test_bcongr test_eq. Import test_derive_stdlib.Coverage. Import test_isK.Coverage. Import test_projK.Coverage. Import test_bcongr.Coverage. Import test_eq.Coverage. Module Coverage. Elpi derive.eqK empty. Elpi derive.eqK unit. Elpi derive.eqK peano. Elpi derive.eqK option. Elpi derive.eqK pair. Elpi derive.eqK seq. Elpi derive.eqK box_peano. Elpi derive.eqK rose. Elpi derive.eqK rose_p. Elpi derive.eqK rose_o. Fail Elpi derive.eqK nest. Fail Elpi derive.eqK w. Fail Elpi derive.eqK vect. Fail Elpi derive.eqK dyn. Elpi derive.eqK zeta. Elpi derive.eqK beta. Fail Elpi derive.eqK iota. (* Elpi derive.eqK large. *) Elpi derive.eqK prim_int. Elpi derive.eqK prim_float. Elpi derive.eqK fo_record. Elpi derive.eqK pa_record. Elpi derive.eqK pr_record. Fail Elpi derive.eqK dep_record. Elpi derive.eqK enum. Fail Elpi derive.eqK sigma_bool. Fail Elpi derive.eqK eq. Elpi derive.eqK bool. Fail Elpi derive.eqK val. Fail Elpi derive.eqK ord. End Coverage. Import Coverage. Import test_eq.Coverage. Check eq_axiom_tt : eq_axiom_at unit unit_eq tt. Check eq_axiom_Zero : eq_axiom_at peano peano_eq Zero. Check eq_axiom_Succ : forall y, eq_axiom_at peano peano_eq y -> eq_axiom_at peano peano_eq (Succ y). Check eq_axiom_None : forall A f, eq_axiom_at (option A) (option_eq A f) (None A). Check eq_axiom_Some : forall A f x, eq_axiom_at A f x -> eq_axiom_at (option A) (option_eq A f) (Some A x). Check eq_axiom_Comma: forall A f B g, forall x, eq_axiom_at A f x -> forall y, eq_axiom_at B g y -> eq_axiom_at (pair A B) (pair_eq A f B g) (Comma A B x y). Check eq_axiom_Nil: forall A f, eq_axiom_at (seq A) (seq_eq A f) (Nil A). Check eq_axiom_Cons : forall A f x, eq_axiom_at A f x -> forall xs, eq_axiom_at (seq A) (seq_eq A f) xs -> eq_axiom_at (seq A) (seq_eq A f) (Cons A x xs). Check eq_axiom_Leaf: forall A f a, eq_axiom_at A f a -> eq_axiom_at (rose A) (rose_eq A f) (Leaf A a). Check eq_axiom_Node: forall A f l, eq_axiom_at (seq (rose A)) (seq_eq (rose A) (rose_eq A f)) l -> eq_axiom_at (rose A) (rose_eq A f) (Node A l). Check eq_axiom_Envelope. Check eq_axiom_Redex. (*Check eq_axiom_K1.*) Check eq_axiom_PI. Check eq_axiom_PF. Check eq_axiom_Build_fo_record : forall x, eq_axiom_at peano peano_eq x -> forall y, eq_axiom_at unit unit_eq y -> eq_axiom_at fo_record fo_record_eq (Build_fo_record x y). Check eq_axiom_Build_pa_record : forall A f, forall x, eq_axiom_at peano peano_eq x -> forall y, eq_axiom_at A f y -> eq_axiom_at (pa_record A) (pa_record_eq A f) (Build_pa_record A x y). Check eq_axiom_Build_pr_record : forall A f, forall x, eq_axiom_at peano peano_eq x -> forall y, eq_axiom_at A f y -> eq_axiom_at (pr_record A) (pr_record_eq A f) (Build_pr_record A x y). Check eq_axiom_E1 : eq_axiom_at enum enum_eq E1. Check eq_axiom_E2 : eq_axiom_at enum enum_eq E2. Check eq_axiom_E3 : eq_axiom_at enum enum_eq E3. coq-elpi-1.19.3/apps/derive/tests/test_eqOK.v000066400000000000000000000056131451177652200210050ustar00rootroot00000000000000From elpi.apps Require Import derive.eqOK. From elpi.apps Require Import test_derive_stdlib test_eqcorrect test_param1 test_param1_trivial. Import test_derive_stdlib.Coverage. Import tests.test_eq.Coverage. Import test_eqcorrect.Coverage. Import test_param1.Coverage. Import test_param1_trivial.Coverage. Module Coverage. Elpi derive.eqOK empty. Elpi derive.eqOK unit. Elpi derive.eqOK peano. Elpi derive.eqOK option. Elpi derive.eqOK pair. Elpi derive.eqOK seq. Elpi derive.eqOK box_peano. Elpi derive.eqOK rose. Elpi derive.eqOK rose_p. Elpi derive.eqOK rose_o. Fail Elpi derive.eqOK nest. Fail Elpi derive.eqOK w. Fail Elpi derive.eqOK vect. Fail Elpi derive.eqOK dyn. Elpi derive.eqOK zeta. Elpi derive.eqOK beta. Fail Elpi derive.eqOK iota. (* Elpi derive.eqOK large. *) Elpi derive.eqOK prim_int. Fail Elpi derive.eqOK prim_float. Elpi derive.eqOK fo_record. Elpi derive.eqOK pa_record. Elpi derive.eqOK pr_record. Fail Elpi derive.eqOK dep_record. Elpi derive.eqOK enum. Elpi derive.eqOK bool. Fail Elpi derive.eqOK eq. Fail Elpi derive.eqOK sigma_bool. Fail Elpi derive.eqOK val. Fail Elpi derive.eqOK ord. End Coverage. Import Coverage eqK. Local Notation ok T F := (forall x, eq_axiom_at T F x). Check empty_eq_OK : ok empty empty_eq. Check unit_eq_OK : ok unit unit_eq. Check peano_eq_OK : ok peano peano_eq. Check option_eq_OK : forall A f, ok A f -> ok (option A) (option_eq A f). Check pair_eq_OK : forall A f, ok A f -> forall B g, ok B g -> ok (pair A B) (pair_eq A f B g). Check seq_eq_OK : forall A f, ok A f -> ok (seq A) (seq_eq A f). Check rose_eq_OK : forall A f, ok A f -> ok (rose A) (rose_eq A f). Fail Check nest_eq_OK. Fail Check w_eq_OK. Fail Check vect_eq_OK. Fail Check dyn_eq_OK. Check zeta_eq_OK : forall A f, ok A f -> ok (zeta A) (zeta_eq A f). Check beta_eq_OK : forall A f, ok A f -> ok (beta A) (beta_eq A f). Fail Check iota_eq_OK. (* Check large_eq_OK : ok large large_eq. *) Check prim_int_eq_OK. Fail Check prim_float_eq_OK. Check fo_record_eq_OK : ok fo_record fo_record_eq. Check pa_record_eq_OK : forall A f, ok A f -> ok (pa_record A) (pa_record_eq A f). Check pr_record_eq_OK : forall A f, ok A f -> ok (pr_record A) (pr_record_eq A f). Check enum_eq_OK : ok enum enum_eq. From elpi.apps Require Import test_param1_functor. Import test_param1_functor.Coverage. Set Uniform Inductive Parameters. Module OtherTests. Import test_param1_functor.Coverage. Inductive dlist A := dnil | dcons (a : pair A peano) (l : dlist). Elpi derive.param1 dlist. Elpi derive.param1.congr is_dlist. Elpi derive.param1.trivial is_dlist. Elpi derive.induction dlist. Elpi derive.projK dlist. Elpi derive.bcongr dlist. Elpi derive.isK dlist. Elpi derive.param1.functor is_dlist. Elpi derive.eq dlist. Elpi derive.eqK dlist. Elpi derive.eqcorrect dlist. Elpi derive.eqOK dlist dlist_eqOK. Check dlist_eqOK : forall A f (h : forall l, eq_axiom_at A f l) l, eq_axiom_at (dlist A) (dlist_eq A f) l. End OtherTests. coq-elpi-1.19.3/apps/derive/tests/test_eqType_ast.v000066400000000000000000000030231451177652200222550ustar00rootroot00000000000000From elpi.apps Require Import derive.eqType_ast. From elpi.apps.derive.tests Require Import test_derive_stdlib. Import test_derive_stdlib.Coverage. Module Coverage. Elpi derive.eqType.ast empty. Elpi derive.eqType.ast unit. Elpi derive.eqType.ast peano. Elpi derive.eqType.ast option. Elpi derive.eqType.ast pair. Elpi derive.eqType.ast seq. Elpi derive.eqType.ast box_peano. Elpi derive.eqType.ast rose. Elpi derive.eqType.ast rose_p. Elpi derive.eqType.ast rose_o. Fail Elpi derive.eqType.ast nest. Fail Elpi derive.eqType.ast w. Fail Elpi derive.eqType.ast vect. Fail Elpi derive.eqType.ast dyn. Fail Elpi derive.eqType.ast zeta. Elpi derive.eqType.ast beta. Fail Elpi derive.eqType.ast iota. Elpi derive.eqType.ast large. Elpi derive.eqType.ast prim_int. Fail Elpi derive.eqType.ast prim_float. Elpi derive.eqType.ast fo_record. Elpi derive.eqType.ast pa_record. Elpi derive.eqType.ast pr_record. Fail Elpi derive.eqType.ast dep_record. Elpi derive.eqType.ast enum. Elpi derive.eqType.ast bool. Fail Elpi derive.eqType.ast eq. Elpi derive.eqType.ast sigma_bool. Elpi derive.eqType.ast ord. Elpi derive.eqType.ast ord2. Elpi derive.eqType.ast val. End Coverage. Import Coverage. Inductive F1 := | K1 : (peano -> peano) -> F1. Fail Elpi derive.eqType.ast F1. Inductive F2 := | K2 : F1 -> F2. Fail Elpi derive.eqType.ast F2. Inductive S1 (x : F1) := | D1. Elpi derive.eqType.ast S1. Inductive S2 (x : F1) := | D2 : S1 x -> S2. Elpi derive.eqType.ast S2. Inductive S3 (f : peano -> peano) := | D3 x : f x = x -> S3. Elpi derive.eqType.ast S3. coq-elpi-1.19.3/apps/derive/tests/test_eqb.v000066400000000000000000000047421451177652200207170ustar00rootroot00000000000000From elpi.apps Require Import derive.eqb. From elpi.apps.derive.tests Require Import test_derive_stdlib test_eqType_ast test_tag test_fields. Import test_derive_stdlib.Coverage test_eqType_ast.Coverage test_tag.Coverage test_fields.Coverage. Module Coverage. Elpi derive.eqb empty. Elpi derive.eqb unit. Elpi derive.eqb peano. Elpi derive.eqb option. Elpi derive.eqb pair. Elpi derive.eqb seq. Elpi derive.eqb box_peano. Elpi derive.eqb rose. Elpi derive.eqb rose_p. Elpi derive.eqb rose_o. Fail Elpi derive.eqb nest. Fail Elpi derive.eqb w. Fail Elpi derive.eqb vect. Fail Elpi derive.eqb dyn. Fail Elpi derive.eqb zeta. Elpi derive.eqb beta. Fail Elpi derive.eqb iota. (* slow Elpi derive.eqb large. *) Elpi derive.eqb prim_int. Fail Elpi derive.eqb prim_float. Elpi derive.eqb fo_record. Elpi derive.eqb pa_record. Elpi derive.eqb pr_record. Fail Elpi derive.eqb dep_record. Elpi derive.eqb enum. Fail Elpi derive.eqb eq. Elpi derive.eqb bool. Elpi derive.eqb sigma_bool. Elpi derive.eqb ord. Elpi derive.eqb ord2. Elpi derive.eqb val. Elpi derive.eqb alias. End Coverage. Import Coverage. Import PArith. Notation eq_test T := (T -> T -> bool). Notation eq_test2 T1 T2 := (T1 -> T2 -> bool). Check empty_eqb : eq_test empty. Check unit_eqb : eq_test unit. Check peano_eqb : eq_test peano. Check option_eqb : forall A, eq_test A -> eq_test (option A). Check pair_eqb : forall A, eq_test A -> forall B, eq_test B -> eq_test (pair A B). Check seq_eqb : forall A, eq_test A -> eq_test (seq A). Check rose_eqb : forall A, eq_test A -> eq_test (rose A). Fail Check nest_eqb. (* Check w_eqb. (* Do something but it is stupide*) *) Fail Check vect_eqb : forall A, eq_test A -> forall i, eq_test (vect A i). Fail Check dyn_eqb. Fail Check zeta_eqb : forall A, eq_test A -> eq_test (zeta A). Check beta_eqb : forall A, eq_test A -> eq_test (beta A). Fail Check iota_eqb : eq_test iota. (* Check large_eqb : eq_test large. *) (* FIXME : the definition of prim_int_eqb_fields*) Check prim_int_eqb : eq_test prim_int. Fail Check prim_float_eqb : eq_test prim_float. Check fo_record_eqb : eq_test fo_record. Check pa_record_eqb : forall A, eq_test A -> eq_test (pa_record A). Check pr_record_eqb : forall A, eq_test A -> eq_test (pr_record A). Check enum_eqb : eq_test enum. Check sigma_bool_eqb : eq_test sigma_bool. Check ord_eqb : forall p1 p2, eq_test2 (ord p1) (ord p2). Check ord2_eqb : forall p1 p2, eq_test2 (ord2 p1) (ord2 p2). Check val_eqb : eq_test val. Check alias_eqb : eq_test alias. coq-elpi-1.19.3/apps/derive/tests/test_eqbOK.v000066400000000000000000000030261451177652200211430ustar00rootroot00000000000000From elpi.apps Require Import derive.eqbOK. From elpi.apps.derive.tests Require Import test_derive_stdlib test_eqb test_eqbcorrect. Import test_derive_stdlib.Coverage test_eqType_ast.Coverage test_eqb.Coverage test_eqbcorrect.Coverage. Module Coverage. Elpi derive.eqbOK empty. Elpi derive.eqbOK unit. Elpi derive.eqbOK peano. Elpi derive.eqbOK option. Elpi derive.eqbOK pair. Elpi derive.eqbOK seq. Elpi derive.eqbOK box_peano. Elpi derive.eqbOK rose. Elpi derive.eqbOK rose_p. Elpi derive.eqbOK rose_o. Fail Elpi derive.eqbOK nest. Fail Elpi derive.eqbOK w. Fail Elpi derive.eqbOK vect. Fail Elpi derive.eqbOK dyn. Fail Elpi derive.eqbOK zeta. Elpi derive.eqbOK beta. Fail Elpi derive.eqbOK iota. (* Elpi derive.eqbOK large. *) Elpi derive.eqbOK prim_int. Fail Elpi derive.eqbOK prim_float. Elpi derive.eqbOK fo_record. Elpi derive.eqbOK pa_record. Elpi derive.eqbOK pr_record. Fail Elpi derive.eqbOK dep_record. Elpi derive.eqbOK enum. Fail Elpi derive.eqbOK eq. Elpi derive.eqbOK bool. Elpi derive.eqbOK sigma_bool. Elpi derive.eqbOK ord. Elpi derive.eqbOK ord2. Elpi derive.eqbOK val. Elpi derive.eqbOK alias. End Coverage. Import Coverage. Check peano_eqb_OK : forall n m, Bool.reflect (n = m) (peano_eqb n m). Check seq_eqb_OK : forall A eqA (h : forall a1 a2 : A, Bool.reflect (a1 = a2) (eqA a1 a2)) l1 l2, Bool.reflect (l1 = l2) (seq_eqb A eqA l1 l2). Check ord_eqb_OK : forall n (o1 o2 : ord n), Bool.reflect (o1 = o2) (ord_eqb n n o1 o2). Check alias_eqb_OK : forall x y : alias, Bool.reflect (x = y) (alias_eqb x y). coq-elpi-1.19.3/apps/derive/tests/test_eqbcorrect.v000066400000000000000000000047451451177652200223040ustar00rootroot00000000000000From elpi.apps Require Import derive.eqbcorrect. From elpi.apps.derive Require Import param1. (* FIXME, the clause is in param1 *) From elpi.apps.derive.tests Require Import test_derive_stdlib test_eqType_ast test_tag test_fields test_eqb test_induction test_param1 test_param1_trivial test_param1_functor. Import test_derive_stdlib.Coverage test_eqType_ast.Coverage test_tag.Coverage test_fields.Coverage test_eqb.Coverage test_induction.Coverage test_param1.Coverage test_param1_trivial.Coverage test_param1_functor.Coverage. Module Coverage. (* Elpi Trace (* "derive.eqbcorrect.*" "derive.param1.functor.*" "correct-lemma-for" *) "param1-functor-for". *) Elpi derive.eqbcorrect empty. Elpi derive.eqbcorrect unit. Elpi derive.eqbcorrect peano. Elpi derive.eqbcorrect option. Elpi derive.eqbcorrect pair. Elpi derive.eqbcorrect seq. Elpi derive.eqbcorrect box_peano. Elpi derive.eqbcorrect rose. Elpi derive.eqbcorrect rose_p. Elpi derive.eqbcorrect rose_o. Fail Elpi derive.eqbcorrect nest. (* Maybe fixable *) Fail Elpi derive.eqbcorrect w. (* Not fixable *) Fail Elpi derive.eqbcorrect vect. (* Can be done *) Fail Elpi derive.eqbcorrect dyn. (* Not Fixable *) Fail Elpi derive.eqbcorrect zeta. (* FIXME *) Elpi derive.eqbcorrect beta. Fail Elpi derive.eqbcorrect iota. (* Elpi derive.eqbcorrect large. *) Elpi derive.eqbcorrect prim_int. Fail Elpi derive.eqbcorrect prim_float. (* Can not work, we don't have a syntaxtic test *) Elpi derive.eqbcorrect fo_record. Elpi derive.eqbcorrect pa_record. Elpi derive.eqbcorrect pr_record. Fail Elpi derive.eqbcorrect dep_record. Elpi derive.eqbcorrect enum. Fail Elpi derive.eqbcorrect eq. Elpi derive.eqbcorrect bool. Elpi derive.eqbcorrect sigma_bool. Elpi derive.eqbcorrect ord. Elpi derive.eqbcorrect ord2. Elpi derive.eqbcorrect val. Elpi derive.eqbcorrect alias. End Coverage. Import Coverage. Check peano_eqb_correct : forall n m, peano_eqb n m = true -> n = m. Check peano_eqb_refl : forall n, peano_eqb n n = true. Check ord_eqb_correct : forall n, eqb_correct (ord_eqb n n). Check ord_eqb_refl : forall n, eqb_reflexive (ord_eqb n n). Check ord2_eqb_correct : forall n, eqb_correct (ord2_eqb n n). Check ord2_eqb_refl : forall n, eqb_reflexive (ord2_eqb n n). Check val_eqb_correct : eqb_correct val_eqb. Check val_eqb_refl : eqb_reflexive val_eqb. Check alias_eqb_correct : eqb_correct alias_eqb. Check alias_eqb_refl : eqb_reflexive alias_eqb. coq-elpi-1.19.3/apps/derive/tests/test_eqcorrect.v000066400000000000000000000054531451177652200221370ustar00rootroot00000000000000From elpi.apps Require Import derive.eqcorrect. From elpi.apps Require Import test_derive_stdlib derive.tests.test_eq test_param1 test_param1_functor test_induction test_eqK. Import test_derive_stdlib.Coverage. Import tests.test_eq.Coverage. Import test_param1.Coverage. Import test_param1_functor.Coverage. Import test_induction.Coverage. Import test_eqK.Coverage. Module Coverage. Elpi derive.eqcorrect empty. Elpi derive.eqcorrect unit. Elpi derive.eqcorrect peano. Elpi derive.eqcorrect option. Elpi derive.eqcorrect pair. Elpi derive.eqcorrect seq. Elpi derive.eqcorrect box_peano. Elpi derive.eqcorrect rose. Elpi derive.eqcorrect rose_p. Elpi derive.eqcorrect rose_o. Fail Elpi derive.eqcorrect nest. Fail Elpi derive.eqcorrect w. Fail Elpi derive.eqcorrect vect. Fail Elpi derive.eqcorrect dyn. Elpi derive.eqcorrect zeta. Elpi derive.eqcorrect beta. Fail Elpi derive.eqcorrect iota. (* Elpi derive.eqcorrect large. *) Elpi derive.eqcorrect prim_int. Fail Elpi derive.eqcorrect prim_float. Elpi derive.eqcorrect fo_record. Elpi derive.eqcorrect pa_record. Elpi derive.eqcorrect pr_record. Fail Elpi derive.eqcorrect dep_record. Elpi derive.eqcorrect enum. Fail Elpi derive.eqcorrect eq. Elpi derive.eqcorrect bool. Fail Elpi derive.eqcorrect sigma_bool. Fail Elpi derive.eqcorrect ord. Fail Elpi derive.eqcorrect val. End Coverage. Import Coverage eqK. Local Notation correct X isX F := (forall x, isX x -> eq_axiom_at X F x). Check empty_eq_correct : correct empty is_empty empty_eq. Check unit_eq_correct : correct unit is_unit unit_eq. Check peano_eq_correct : correct peano is_peano peano_eq. Check option_eq_correct : forall A f, correct (option A) (is_option A (eq_axiom_at A f)) (option_eq A f). Check pair_eq_correct : forall A f B g, correct (pair A B) (is_pair A (eq_axiom_at A f) B (eq_axiom_at B g)) (pair_eq A f B g). Check seq_eq_correct : forall A f, correct (seq A) (is_seq A (eq_axiom_at A f)) (seq_eq A f). Check rose_eq_correct : forall A f, correct (rose A) (is_rose A (eq_axiom_at A f)) (rose_eq A f). Fail Check nest_eq_correct. Fail Check w_eq_correct. Fail Check vect_eq_correct. Fail Check dyn_eq_correct. Check zeta_eq_correct : forall A f, correct (zeta A) (is_zeta A (eq_axiom_at A f)) (zeta_eq A f). Check beta_eq_correct : forall A f, correct (beta A) (is_beta A (eq_axiom_at A f)) (beta_eq A f). Fail Check iota_eq_correct. (* Check large_eq_correct : correct large is_large large_eq. *) Check prim_int_eq_correct. Fail Check prim_float_eq_correct. Check fo_record_eq_correct : correct fo_record is_fo_record fo_record_eq. Check pa_record_eq_correct : forall A f, correct (pa_record A) (is_pa_record A (eq_axiom_at A f)) (pa_record_eq A f). Check pr_record_eq_correct : forall A f, correct (pr_record A) (is_pr_record A (eq_axiom_at A f)) (pr_record_eq A f). Check enum_eq_correct : correct enum is_enum enum_eq. coq-elpi-1.19.3/apps/derive/tests/test_fields.v000066400000000000000000000227731451177652200214220ustar00rootroot00000000000000From elpi.apps Require Import derive.fields. From elpi.apps.derive.tests Require Import test_derive_stdlib test_eqType_ast test_tag. Import test_derive_stdlib.Coverage test_eqType_ast.Coverage test_tag.Coverage. Module Coverage. Elpi derive.fields empty. Elpi derive.fields unit. Elpi derive.fields peano. Elpi derive.fields option. Elpi derive.fields pair. Elpi derive.fields seq. Elpi derive.fields box_peano. Elpi derive.fields rose. Elpi derive.fields rose_p. Elpi derive.fields rose_o. Fail Elpi derive.fields nest. Fail Elpi derive.fields w. Fail Elpi derive.fields vect. Fail Elpi derive.fields dyn. Fail Elpi derive.fields zeta. Elpi derive.fields beta. Fail Elpi derive.fields iota. Elpi derive.fields large. Elpi derive.fields prim_int. Fail Elpi derive.fields prim_float. Elpi derive.fields fo_record. Elpi derive.fields pa_record. Elpi derive.fields pr_record. Fail Elpi derive.fields dep_record. Elpi derive.fields enum. Elpi derive.fields bool. Fail Elpi derive.fields eq. Elpi derive.fields sigma_bool. Elpi derive.fields ord. Elpi derive.fields ord2. Elpi derive.fields val. End Coverage. Import Coverage. Import PArith. Check empty_fields_t : positive -> Type. Check empty_fields : forall (n:empty), empty_fields_t (empty_tag n). Check empty_construct : forall (p: positive), empty_fields_t p -> Datatypes.option empty. Check empty_constructP : forall (n:empty), empty_construct (empty_tag n) (empty_fields n) = Datatypes.Some n. Check unit_fields_t : positive -> Type. Check unit_fields : forall (n:unit), unit_fields_t (unit_tag n). Check unit_construct : forall (p: positive), unit_fields_t p -> Datatypes.option unit. Check unit_constructP : forall (n:unit), unit_construct (unit_tag n) (unit_fields n) = Datatypes.Some n. Check peano_fields_t : positive -> Type. Check peano_fields : forall (n:peano), peano_fields_t (peano_tag n). Check peano_construct : forall (p: positive), peano_fields_t p -> Datatypes.option peano. Check peano_constructP : forall (n:peano), peano_construct (peano_tag n) (peano_fields n) = Datatypes.Some n. Check option_fields_t : Type -> Numbers.BinNums.positive -> Type. Check option_fields : forall (A:Type) (l:option A), option_fields_t A (option_tag A l). Check option_construct : forall (A:Type) (p: Numbers.BinNums.positive), option_fields_t A p -> Datatypes.option (option A). Check option_constructP : forall (A:Type) (l:option A), option_construct A (option_tag A l) (option_fields A l) = Datatypes.Some l. Check pair_fields_t : Type -> Type -> Numbers.BinNums.positive -> Type. Check pair_fields : forall (A B :Type) (l:pair A B), pair_fields_t A B (pair_tag A B l). Check pair_construct : forall (A B:Type) (p: Numbers.BinNums.positive), pair_fields_t A B p -> Datatypes.option (pair A B). Check pair_constructP : forall (A B:Type) (l:pair A B), pair_construct A B (pair_tag A B l) (pair_fields A B l) = Datatypes.Some l. Check seq_fields_t : Type -> Numbers.BinNums.positive -> Type. Check seq_fields : forall (A:Type) (l:seq A), seq_fields_t A (seq_tag A l). Check seq_construct : forall (A:Type) (p: Numbers.BinNums.positive), seq_fields_t A p -> Datatypes.option (seq A). Check seq_constructP : forall (A:Type) (l:seq A), seq_construct A (seq_tag A l) (seq_fields A l) = Datatypes.Some l. Check rose_fields_t : Type -> Numbers.BinNums.positive -> Type. Check rose_fields : forall (A:Type) (l:rose A), rose_fields_t A (rose_tag A l). Check rose_construct : forall (A:Type) (p: Numbers.BinNums.positive), rose_fields_t A p -> Datatypes.option (rose A). Check rose_constructP : forall (A:Type) (l:rose A), rose_construct A (rose_tag A l) (rose_fields A l) = Datatypes.Some l. Fail Check nest_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check nest_fields : forall (A:Type) (l:nest A), nest_fields_t A (nest_tag A l). Fail Check nest_construct : forall (A:Type) (p: Numbers.BinNums.positive), nest_fields_t A p -> Datatypes.option (nest A). Fail Check nest_constructP : forall (A:Type) (l:nest A), nest_construct A (nest_tag A l) (nest_fields A l) = Datatypes.Some l. Fail Check w_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check w_fields : forall (A:Type) (l:w A), w_fields_t A (w_tag A l). Fail Check w_construct : forall (A:Type) (p: Numbers.BinNums.positive), w_fields_t A p -> Datatypes.option (w A). Fail Check w_constructP : forall (A:Type) (l:w A), w_construct A (w_tag A l) (w_fields A l) = Datatypes.Some l. Fail Check vect_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check vect_fields : forall (A:Type) (l:vect A), vect_fields_t A (vect_tag A l). Fail Check vect_construct : forall (A:Type) (p: Numbers.BinNums.positive), vect_fields_t A p -> Datatypes.option (vect A). Fail Check vect_constructP : forall (A:Type) (l:vect A), vect_construct A (vect_tag A l) (vect_fields A l) = Datatypes.Some l. Fail Check dyn_fields_t : positive -> Type. Fail Check dyn_fields : forall (n:dyn), dyn_fields_t (dyn_tag n). Fail Check dyn_construct : forall (p: positive), dyn_fields_t p -> Datatypes.option dyn. Fail Check dyn_constructP : forall (n:dyn), dyn_construct (dyn_tag n) (dyn_fields n) = Datatypes.Some n. Fail Check zeta_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check zeta_fields : forall (A:Type) (l:zeta A), zeta_fields_t A (zeta_tag A l). Fail Check zeta_construct : forall (A:Type) (p: Numbers.BinNums.positive), zeta_fields_t A p -> option (zeta A). Fail Check zeta_constructP : forall (A:Type) (l:zeta A), zeta_construct A (zeta_tag A l) (zeta_fields A l) = Some l. Check beta_fields_t : Type -> Numbers.BinNums.positive -> Type. Check beta_fields : forall (A:Type) (l:beta A), beta_fields_t A (beta_tag A l). Check beta_construct : forall (A:Type) (p: Numbers.BinNums.positive), beta_fields_t A p -> Datatypes.option (beta A). Check beta_constructP : forall (A:Type) (l:beta A), beta_construct A (beta_tag A l) (beta_fields A l) = Datatypes.Some l. Fail Check iota_fields_t : positive -> Type. Fail Check iota_fields : forall (n:iota), iota_fields_t (iota_tag n). Fail Check iota_construct : forall (p: positive), iota_fields_t p -> Datatypes.option iota. Fail Check iota_constructP : forall (n:iota), iota_construct (iota_tag n) (iota_fields n) = Datatypes.Some n. Check large_fields_t : positive -> Type. Check large_fields : forall (n:large), large_fields_t (large_tag n). Check large_construct : forall (p: positive), large_fields_t p -> Datatypes.option large. Check large_constructP : forall (n:large), large_construct (large_tag n) (large_fields n) = Datatypes.Some n. Check prim_int_fields_t : positive -> Type. Check prim_int_fields : forall (n:prim_int), prim_int_fields_t (prim_int_tag n). Check prim_int_construct : forall (p: positive), prim_int_fields_t p -> Datatypes.option prim_int. Check prim_int_constructP : forall (n:prim_int), prim_int_construct (prim_int_tag n) (prim_int_fields n) = Datatypes.Some n. Fail Check prim_float_fields_t : positive -> Type. Fail Check prim_float_fields : forall (n:prim_float), prim_float_fields_t (prim_float_tag n). Fail Check prim_float_construct : forall (p: positive), prim_float_fields_t p -> Datatypes.option prim_float. Fail Check prim_float_constructP : forall (n:prim_float), prim_float_construct (prim_float_tag n) (prim_float_fields n) = Datatypes.Some n. Check pa_record_fields_t : Type -> Numbers.BinNums.positive -> Type. Check pa_record_fields : forall (A:Type) (l:pa_record A), pa_record_fields_t A (pa_record_tag A l). Check pa_record_construct : forall (A:Type) (p: Numbers.BinNums.positive), pa_record_fields_t A p -> Datatypes.option (pa_record A). Check pa_record_constructP : forall (A:Type) (l:pa_record A), pa_record_construct A (pa_record_tag A l) (pa_record_fields A l) = Datatypes.Some l. Check pr_record_fields_t : Type -> Numbers.BinNums.positive -> Type. Check pr_record_fields : forall (A:Type) (l:pr_record A), pr_record_fields_t A (pr_record_tag A l). Check pr_record_construct : forall (A:Type) (p: Numbers.BinNums.positive), pr_record_fields_t A p -> Datatypes.option (pr_record A). Check pr_record_constructP : forall (A:Type) (l:pr_record A), pr_record_construct A (pr_record_tag A l) (pr_record_fields A l) = Datatypes.Some l. Check sigma_bool_fields_t : Numbers.BinNums.positive -> Type. Check sigma_bool_fields : forall (l:sigma_bool), sigma_bool_fields_t (sigma_bool_tag l). Check sigma_bool_construct : forall (p: Numbers.BinNums.positive), sigma_bool_fields_t p -> Datatypes.option sigma_bool. Check sigma_bool_constructP : forall (l:sigma_bool), sigma_bool_construct (sigma_bool_tag l) (sigma_bool_fields l) = Datatypes.Some l. Check ord_fields_t : peano -> Numbers.BinNums.positive -> Type. Check ord_fields : forall (p:peano) (o:ord p), ord_fields_t p (ord_tag p o). Check ord_construct : forall (n:peano) (p:Numbers.BinNums.positive), ord_fields_t n p -> Datatypes.option (ord n). Check ord_constructP : forall (p:peano) (o:ord p), ord_construct p (ord_tag p o) (ord_fields p o) = Datatypes.Some o. Check ord2_fields_t : peano -> Numbers.BinNums.positive -> Type. Check ord2_fields : forall (p:peano) (o:ord2 p), ord2_fields_t p (ord2_tag p o). Check ord2_construct : forall (n:peano) (p:Numbers.BinNums.positive), ord2_fields_t n p -> Datatypes.option (ord2 n). Check ord2_constructP : forall (p:peano) (o:ord2 p), ord2_construct p (ord2_tag p o) (ord2_fields p o) = Datatypes.Some o. Check val_fields_t : Numbers.BinNums.positive -> Type. Check val_fields : forall i : val, val_fields_t (val_tag i). Check val_construct : forall (p: Numbers.BinNums.positive), val_fields_t p -> Datatypes.option val. Check val_constructP : forall (v:val), val_construct (val_tag v) (val_fields v) = Datatypes.Some v. coq-elpi-1.19.3/apps/derive/tests/test_idx2inv.v000066400000000000000000000004041451177652200215220ustar00rootroot00000000000000From elpi.apps Require Import derive.param1 derive.invert derive.induction derive.idx2inv. Elpi derive.param1 list. Elpi derive.invert is_list. Elpi derive.idx2inv is_list. Check is_list_to_is_list_inv : forall A PA l, is_list A PA l -> is_list_inv A PA l.coq-elpi-1.19.3/apps/derive/tests/test_induction.v000066400000000000000000000101461451177652200221370ustar00rootroot00000000000000From elpi.apps Require Import derive.induction. From elpi.apps Require Import test_derive_stdlib test_param1 test_param1_functor. Import test_derive_stdlib.Coverage. Import derive.param1. (* for is_eq *) Import test_param1.Coverage. Import test_param1_functor.Coverage. Module Coverage. Elpi derive.induction empty. Elpi derive.induction unit. Elpi derive.induction peano. Elpi derive.induction option. Elpi derive.induction pair. Elpi derive.induction seq. Elpi derive.induction box_peano. Elpi derive.induction rose. Elpi derive.induction rose_p. Elpi derive.induction rose_o. Elpi derive.induction nest. Elpi derive.induction w. Elpi derive.induction vect. Elpi derive.induction dyn. Elpi derive.induction zeta. Elpi derive.induction beta. Elpi derive.induction iota. Elpi derive.induction large. Elpi derive.induction prim_int. Elpi derive.induction prim_float. Elpi derive.induction fo_record. Elpi derive.induction pa_record. Elpi derive.induction pr_record. Elpi derive.induction dep_record. Elpi derive.induction enum. Elpi derive.induction eq. Elpi derive.induction bool. Elpi derive.induction sigma_bool. Elpi derive.induction ord. Elpi derive.induction ord2. Elpi derive.induction val. End Coverage. Import Coverage. Locate is_unit. Check empty_induction : forall P : empty -> Prop, forall x, is_empty x -> P x. Check unit_induction : forall P : unit -> Prop, P tt -> forall x, is_unit x -> P x. Check peano_induction : forall P, P Zero -> (forall n, P n -> P (Succ n)) -> forall x, is_peano x -> P x. Check option_induction : forall A PA P, (P (None A)) -> (forall a, PA a -> P (Some A a)) -> forall x, is_option A PA x -> P x. Check pair_induction : forall A PA B PB P, (forall a, PA a -> forall b, PB b -> P (Comma A B a b)) -> forall x, is_pair A PA B PB x -> P x. Check seq_induction : forall A PA P, P (Nil A) -> (forall x, PA x -> forall xs, P xs -> P (Cons A x xs)) -> forall l, is_seq A PA l -> P l. Check rose_induction : forall A PA P, (forall x, PA x -> P (Leaf A x)) -> (forall l, is_seq (rose A) P l -> P (Node A l)) -> forall x, is_rose A PA x -> P x. Check nest_induction : forall P : forall A : Type, (A -> Type) -> nest A -> Type, (forall A PA, P A PA (NilN A)) -> (forall A PA x, PA x -> forall xs, P (pair A A) (is_pair A PA A PA) xs -> P A PA (ConsN A x xs)) -> forall A PA n, is_nest A PA n -> P A PA n. Check w_induction : forall A PA P, (forall f, (forall a, PA a -> P (f a)) -> P (via A f)) -> forall x, is_w A PA x -> P x. Check vect_induction : forall A PA (P : forall n, is_peano n -> vect A n -> Type), P Zero is_Zero (VNil A) -> (forall a, PA a -> forall n, forall nR: is_peano n, forall v : vect A n, P n nR v -> P (Succ n) (is_Succ n nR) (VCons A a n v)) -> forall l lR x, is_vect A PA l lR x -> P l lR x. Check dyn_induction : forall P, (forall T PT (t : T), PT t -> P (box T t)) -> forall x, is_dyn x -> P x. Check zeta_induction : forall A PA P, (forall a, PA a -> forall c, PA c -> P (Envelope A a c)) -> forall x, is_zeta A PA x -> P x. Check iota_induction. Check large_induction. Check prim_int_induction. Check prim_float_induction. Check fo_record_induction : forall P, (forall x, is_peano x -> forall y, is_unit y -> P (Build_fo_record x y)) -> forall x, is_fo_record x -> P x. Check pa_record_induction : forall A PA P, (forall x, is_peano x -> forall y, PA y -> P (Build_pa_record A x y)) -> forall x, is_pa_record A PA x -> P x. Check pr_record_induction : forall A pr P, (forall x, is_peano x -> forall y, pr y -> P (Build_pr_record A x y)) -> forall x, is_pr_record A pr x -> P x. Check dep_record_induction : forall P, (forall x (px : is_peano x) y, is_vect unit is_unit x px y -> P (Build_dep_record x y)) -> forall x, is_dep_record x -> P x. Check enum_induction : forall P, (P E1) -> (P E2) -> (P E3) -> forall x, is_enum x -> P x. Check sigma_bool_induction. Check ord_induction : forall p Pp P, (forall n Pn l, is_eq bool is_bool (is_leq n p) (is_is_leq n Pn p Pp) true is_true l -> P (mkOrd p n l)) -> forall (o : ord p), is_ord p Pp o -> P o. Check ord2_induction : forall p Pp P, (forall (o1 : ord p), is_ord p Pp o1 -> forall (o2 : ord p), is_ord p Pp o2 -> P (mkOrd2 p o1 o2)) -> forall (o : ord2 p), is_ord2 p Pp o -> P o. coq-elpi-1.19.3/apps/derive/tests/test_invert.v000066400000000000000000000010761451177652200214540ustar00rootroot00000000000000From elpi.apps Require Import derive.invert. Inductive test A : bool -> Type := K1 : test true | K2 : forall x, A -> test (negb x) -> test (negb (negb x)). Elpi derive.invert test. Check test_inv : Type -> bool -> Type. Check K1_inv : forall A b, b = true -> test_inv A b. Check K2_inv : forall A b, forall x, A -> test_inv A (negb x) -> b = negb (negb x) -> test_inv A b. Inductive listR A PA : list A -> Type := | nilR : listR (@nil A) | consR : forall a : A, PA a -> forall xs : list A, listR xs -> listR (cons a xs). Elpi derive.invert listR. Print listR_inv.coq-elpi-1.19.3/apps/derive/tests/test_isK.v000066400000000000000000000037671451177652200207040ustar00rootroot00000000000000From elpi.apps Require Import test_derive_stdlib derive.isK. Import test_derive_stdlib.Coverage. (* coverage *) Module Coverage. Elpi derive.isK empty. Elpi derive.isK unit. Elpi derive.isK peano. Elpi derive.isK option. Elpi derive.isK pair. Elpi derive.isK seq. Elpi derive.isK box_peano. Elpi derive.isK rose. Elpi derive.isK rose_p. Elpi derive.isK rose_o. Elpi derive.isK nest. Elpi derive.isK w. Elpi derive.isK vect. Elpi derive.isK dyn. Elpi derive.isK zeta. Elpi derive.isK beta. Elpi derive.isK iota. Elpi derive.isK large. Elpi derive.isK prim_int. Elpi derive.isK prim_float. Elpi derive.isK fo_record. Elpi derive.isK pa_record. Elpi derive.isK pr_record. Elpi derive.isK dep_record. Elpi derive.isK enum. Elpi derive.isK bool. Elpi derive.isK eq. Elpi derive.isK sigma_bool. Elpi derive.isK ord. Elpi derive.isK val. End Coverage. Import Coverage. Check unit_is_tt : unit -> bool. Check peano_is_Zero : peano -> bool. Check peano_is_Succ : peano -> bool. Check option_is_None : forall A, option A -> bool. Check option_is_Some : forall A, option A -> bool. Check pair_is_Comma : forall A B, pair A B -> bool. Check seq_is_Nil : forall A, seq A -> bool. Check seq_is_Cons : forall A, seq A -> bool. Check rose_is_Leaf : forall A, rose A -> bool. Check rose_is_Node : forall A, rose A -> bool. Check nest_is_NilN : forall A, nest A -> bool. Check nest_is_ConsN : forall A, nest A -> bool. Check w_is_via : forall A, w A -> bool. Check vect_is_VNil : forall A i, vect A i -> bool. Check vect_is_VCons : forall A i, vect A i -> bool. Check dyn_is_box : dyn -> bool. Check zeta_is_Envelope : forall A, zeta A -> bool. Check beta_is_Redex : forall A, beta A -> bool. Check iota_is_Why : iota -> bool. Check large_is_K1. Check large_is_K2. Check prim_int_is_PI. Check prim_float_is_PF. Check fo_record_is_Build_fo_record : fo_record -> bool. Check pa_record_is_Build_pa_record : forall A, pa_record A -> bool. Check pr_record_is_Build_pr_record : forall A, pr_record A -> bool. Check enum_is_E1 : enum -> bool. coq-elpi-1.19.3/apps/derive/tests/test_lens.v000066400000000000000000000016031451177652200211020ustar00rootroot00000000000000From elpi.apps Require Import test_derive_stdlib derive.lens. Import test_derive_stdlib.Coverage. (* coverage *) Module Coverage. Elpi derive.lens fo_record. Elpi derive.lens pa_record. Elpi derive.lens pr_record. Fail Elpi derive.lens dep_record. Fail Elpi derive.lens sigma_bool. End Coverage. Import Coverage. Check _f1 : Lens fo_record fo_record peano peano. Check _f2 : Lens fo_record fo_record unit unit. Check @_f3 : forall A, Lens (pa_record A) (pa_record A) peano peano. Check @_f4 : forall A, Lens (pa_record A) (pa_record A) A A. Check @_pf3 : forall A, Lens (pr_record A) (pr_record A) peano peano. Check @_pf4 : forall A, Lens (pr_record A) (pr_record A) A A. Goal forall A x, x = @_pf3 A. intros; unfold _pf3. match goal with | |- x = {| over := fun f r => {| pf3 := f (_ r); pf4 := _ r |} ; view := _ |} => idtac "ok" | |- _ => fail "not primitive" end. Abort. coq-elpi-1.19.3/apps/derive/tests/test_lens_laws.v000066400000000000000000000030051451177652200221260ustar00rootroot00000000000000 From elpi.apps Require Import derive.lens_laws. From elpi.apps Require Import test_derive_stdlib test_lens. Import test_derive_stdlib.Coverage. Import test_lens.Coverage. (* coverage *) Module Coverage. Elpi derive.lens_laws fo_record. Elpi derive.lens_laws pa_record. Elpi derive.lens_laws pr_record. Elpi derive.lens_laws dep_record. Elpi derive.lens_laws sigma_bool. End Coverage. Import Coverage. Check _f1_view_set : view_set _f1. Check _f2_view_set : view_set _f2. Check _f3_view_set : forall A, view_set (_f3 A). Check _f4_view_set : forall A, view_set (_f4 A). Check _pf3_view_set : forall A, view_set (_pf3 A). Check _pf4_view_set : forall A, view_set (_pf4 A). Check _f1_set_set : set_set _f1. Check _f2_set_set : set_set _f2. Check _f3_set_set : forall A, set_set (_f3 A). Check _f4_set_set : forall A, set_set (_f4 A). Check _pf3_set_set : forall A, set_set (_pf3 A). Check _pf4_set_set : forall A, set_set (_pf4 A). Check _f1_set_view : set_view _f1. Check _f2_set_view : set_view _f2. Check _f3_set_view : forall A, set_view (_f3 A). Check _f4_set_view : forall A, set_view (_f4 A). Check _pf3_set_view : forall A, set_view (_pf3 A). Check _pf4_set_view : forall A, set_view (_pf4 A). Check _f1_f2_exchange : exchange _f1 _f2. Check _f2_f1_exchange : exchange _f2 _f1. Check _f3_f4_exchange : forall A, exchange (_f3 A) (_f4 A). Check _f4_f3_exchange : forall A, exchange (_f4 A) (_f3 A). Check _pf3_pf4_exchange : forall A, exchange (_pf3 A) (_pf4 A). Check _pf4_pf3_exchange : forall A, exchange (_pf4 A) (_pf3 A). coq-elpi-1.19.3/apps/derive/tests/test_map.v000066400000000000000000000032461451177652200207230ustar00rootroot00000000000000From elpi.apps Require Import derive.map. From elpi.apps.derive.tests Require Import test_derive_stdlib. Import test_derive_stdlib.Coverage. Module Coverage. Elpi derive.map empty. Elpi derive.map unit. Elpi derive.map peano. Elpi derive.map option. Elpi derive.map pair. Elpi derive.map seq. Elpi derive.map box_peano. Elpi derive.map rose. Elpi derive.map rose_p. Elpi derive.map rose_o. Fail Elpi derive.map nest. Fail Elpi derive.map w. Elpi derive.map vect. Elpi derive.map dyn. Elpi derive.map zeta. Fail Elpi derive.map beta. Elpi derive.map iota. Elpi derive.map large. Elpi derive.map prim_int. Elpi derive.map prim_float. Elpi derive.map fo_record. Elpi derive.map pa_record. Elpi derive.map pr_record. Elpi derive.map dep_record. Elpi derive.map enum. Fail Elpi derive.map eq. Elpi derive.map bool. Elpi derive.map sigma_bool. Fail Elpi derive.map ord. Elpi derive.map val. End Coverage. Import Coverage. Local Notation map T := (T -> T). Local Notation map1 T := (forall X Y, (X -> Y) -> T X%type -> T Y%type). Check empty_map : map empty. Check unit_map : map unit. Check peano_map : map peano. Check option_map : map1 option. Check pair_map : forall A B (f : A -> B) C D (g : C -> D), (pair A C) -> (pair B D). Check seq_map : map1 seq. Check rose_map : map1 rose. Fail Check nest_map. Fail Check w_map. Check vect_map : forall A B (f : A -> B) i, vect A i -> vect B i. Check dyn_map : map dyn. Check zeta_map : forall A B (f : A -> B), zeta A -> zeta B. Fail Check beta_map. Check iota_map : map iota. Check large_map : map large. Check prim_int_map : map prim_int. Check prim_float_map : map prim_float. Check pa_record_map : map1 pa_record. Check pr_record_map : map1 pr_record. coq-elpi-1.19.3/apps/derive/tests/test_param1.v000066400000000000000000000121011451177652200213150ustar00rootroot00000000000000From elpi.apps Require Import derive.param1. From elpi.apps.derive.tests Require Import test_derive_stdlib. Import test_derive_stdlib.Coverage. Module Coverage. Elpi derive.param1 empty. Elpi derive.param1 unit. Elpi derive.param1 peano. Elpi derive.param1 option. Elpi derive.param1 pair. Elpi derive.param1 seq. Elpi derive.param1 box_peano. Elpi derive.param1 rose. Elpi derive.param1 rose_p. Elpi derive.param1 rose_o. Elpi derive.param1 nest. Elpi derive.param1 w. Elpi derive.param1 vect. Elpi derive.param1 dyn. Elpi derive.param1 zeta. Elpi derive.param1 beta. Elpi derive.param1 iota. Elpi derive.param1 large. Elpi derive.param1 prim_int. Elpi derive.param1 prim_float. Elpi derive.param1 fo_record. Elpi derive.param1 pa_record. Elpi derive.param1 pr_record. Elpi derive.param1 dep_record. Elpi derive.param1 enum. (* Elpi derive.param1 eq. (* done in param1.v *) *) Elpi derive.param1 bool. Elpi derive.param1 is_zero. Elpi derive.param1 sigma_bool. Elpi derive.param1 is_leq. Elpi derive.param1 ord. Elpi derive.param1 ord2. Elpi derive.param1 val. End Coverage. Import Coverage. Section Test. Local Notation pred X := (X -> Type). Check is_empty : pred empty. Check is_unit : pred unit. Check is_peano : pred peano. Check is_option : forall A, pred A -> pred (option A). Check is_pair : forall A, pred A -> forall B, pred B -> pred (pair A B). Check is_seq : forall A, pred A -> pred (seq A). Check is_rose : forall A, pred A -> pred (rose A). Check is_nest : forall A, pred A -> pred (nest A). Check is_w : forall A, pred A -> pred (w A). Check is_vect : forall A, pred A -> forall i, is_peano i -> pred (vect A i). Check is_dyn : pred dyn. Check is_zeta : forall A, pred A -> pred (zeta A). Check is_beta : forall A, pred A -> pred (beta A). Check is_iota : pred iota. Check is_large : pred large. Check is_prim_int : pred prim_int. Check is_prim_float : pred prim_float. Check is_fo_record : pred fo_record. Check is_pa_record : forall A, pred A -> pred (pa_record A). Check is_pr_record : forall A, pred A -> pred (pr_record A). Check is_enum : pred enum. Check is_ord : forall (p : peano) (pa : is_peano p), pred (ord p). Check is_ord2 : forall (p : peano) (pa : is_peano p), pred (ord2 p). Check is_val : pred val. End Test. (* other tests by Cyril *) Set Uniform Inductive Parameters. Module OtherTests. Elpi derive.param1 unit. Elpi derive.param1 nat. Inductive fin : nat -> Type := FO : fin 0 | FS : forall n : nat, fin n -> fin (S n). Elpi derive.param1 fin. Fixpoint fin_length n (v : fin n) := match v with FO => 0 | FS _ w => S (fin_length _ w) end. Elpi derive.param1 fin_length. Inductive vec (A : Type) : nat -> Type := vnil : vec 0 | vcons : A -> forall n : nat, vec n -> vec (S n). Elpi derive.param1 vec. Fixpoint vec_length (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param1 vec_length. Elpi derive.param1 list. Elpi derive.param1 is_list. Elpi derive.param1 eq. Fixpoint plus' m n := match n with 0 => m | S n => S (plus' m n) end. Elpi derive.param1 plus'. Elpi derive.param1 plus. Elpi derive.param1 prod. Elpi derive.param1 fst. Elpi derive.param1 snd. Elpi derive.param1 bool. Elpi derive.param1 Nat.divmod. Elpi derive.param1 Nat.div. Definition test m n p q r := m + n + p + q + r. Elpi derive.param1 test. Definition vec_length_type := forall (A : Type) (n : nat), vec A n -> nat. Elpi derive.param1 vec_length_type. Definition vec_length_rec (vec_length : vec_length_type) (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param1 vec_length_rec. Elpi Query derive.param1 lp:{{ reali {{O}} Y }}. Elpi Query derive.param1 lp:{{ reali {{S (S 0)}} Y }}. Definition nat2nat := nat -> nat. Definition nat2nat2nat := nat -> nat -> nat. Elpi derive.param1 nat2nat. Elpi derive.param1 nat2nat2nat. Elpi derive.param1 pred. Print is_pred. Check (is_pred : is_nat2nat pred). Fixpoint predn n := match n with 0 => 0 | S n => S (predn n) end. Elpi derive.param1 predn. Check (is_predn : is_nat2nat predn). Check (is_add : is_nat2nat2nat plus). Fixpoint quasidn n m := S (match n with 0 => m | S n => S (quasidn n m) end). Elpi derive.param1 quasidn. Fixpoint weirdn n := match n with S (S n) => S (weirdn n) | _ => 0 end. Elpi derive.param1 weirdn. Inductive bla : nat -> Type := Bla : nat -> bla 0 | Blu n : bla n -> bla 1. Elpi derive.param1 bla. Print is_bla. Elpi Query derive.param1 lp:{{ coq.TC.db-for {coq.term->gref {{@reali_db}}} PDb }}. Fixpoint silly (n : nat) := n. Elpi derive.param1 silly. (* issue #262 *) Definition foo (a : unit) : unit := let b := a in a. Elpi derive.param1 foo. (* issue #266 *) Elpi derive.param1 option. Definition upair : Set := unit * unit. Elpi derive.param1 upair. Definition uplist := list upair. Elpi derive.param1 uplist. Elpi Print derive.param1. Fixpoint bar (pl : uplist) (id : unit) : option unit := None unit. Elpi derive.param1 bar. Fixpoint nat_eq (n m : nat) {struct n} : bool := match n, m with | O, O => true | S a, S b => nat_eq a b | _, _ => false end. Elpi derive.param1 nat_eq. End OtherTests. coq-elpi-1.19.3/apps/derive/tests/test_param1_congr.v000066400000000000000000000062671451177652200225250ustar00rootroot00000000000000From elpi.apps Require Import derive.param1_congr. From elpi.apps Require Import test_derive_stdlib test_param1. Import test_derive_stdlib.Coverage. Import test_param1.Coverage. Module Coverage. Elpi derive.param1.congr is_empty. Elpi derive.param1.congr is_unit. Elpi derive.param1.congr is_peano. Elpi derive.param1.congr is_option. Elpi derive.param1.congr is_pair. Elpi derive.param1.congr is_seq. Elpi derive.param1.congr is_box_peano. Elpi derive.param1.congr is_nest. Elpi derive.param1.congr is_rose. Elpi derive.param1.congr is_rose_p. Elpi derive.param1.congr is_rose_o. Elpi derive.param1.congr is_w. Elpi derive.param1.congr is_vect. Elpi derive.param1.congr is_dyn. Elpi derive.param1.congr is_zeta. Elpi derive.param1.congr is_beta. Elpi derive.param1.congr is_iota. (* Elpi derive.param1.congr is_large. (* slow *) *) Elpi derive.param1.congr is_prim_int. Elpi derive.param1.congr is_prim_float. Elpi derive.param1.congr is_fo_record. Elpi derive.param1.congr is_pa_record. Elpi derive.param1.congr is_pr_record. Elpi derive.param1.congr is_dep_record. Elpi derive.param1.congr is_enum. Elpi derive.param1.congr is_bool. Elpi derive.param1.congr is_eq. Elpi derive.param1.congr is_sigma_bool. Elpi derive.param1.congr is_ord. Elpi derive.param1.congr is_val. End Coverage. Import Coverage. Check congr_is_tt : is_tt = is_tt. Check congr_is_Zero : is_Zero = is_Zero. Check congr_is_Succ : forall x p1 p2, p1 = p2 -> is_Succ x p1 = is_Succ x p2. Check congr_is_None : forall A PA, is_None A PA = is_None A PA. Check congr_is_Some : forall A PA x p1 p2, p1 = p2 -> is_Some A PA x p1 = is_Some A PA x p2. Check congr_is_Comma : forall A PA B PB x p1 p2, p1 = p2 -> forall y q1 q2, q1 = q2 -> is_Comma A PA B PB x p1 y q1 = is_Comma A PA B PB x p2 y q2. Check congr_is_Nil : forall A PA, is_Nil A PA = is_Nil A PA. Check congr_is_Cons : forall A PA x p1 p2, p1 = p2 -> forall y q1 q2, q1 = q2 -> is_Cons A PA x p1 y q1 = is_Cons A PA x p2 y q2. Check congr_is_Leaf : forall A PA x p1 p2, p1 = p2 -> is_Leaf A PA x p1 = is_Leaf A PA x p2. Check congr_is_Node : forall A PA x p1 p2, p1 = p2 -> is_Node A PA x p1 = is_Node A PA x p2. Fail Check congr_is_NilN. Fail Check congr_is_ConsN. Check congr_is_via : forall A PA x p1 p2, p1 = p2 -> is_via A PA x p1 = is_via A PA x p2. Check congr_is_VNil : forall A PA, is_VNil A PA = is_VNil A PA. Fail Check congr_is_VCons. Fail Check congr_is_box. Check congr_is_Envelope : forall A PA x p1 p2, p1 = p2 -> forall y q1 q2, q1 = q2 -> is_Envelope A PA x p1 y q1 = is_Envelope A PA x p2 y q2. Check congr_is_Redex : forall A PA x p1 p2, p1 = p2 -> is_Redex A PA x p1 = is_Redex A PA x p2. Fail Check congr_is_Why. (* Check congr_is_K1 . *) Check congr_is_PI. Check congr_is_PF. Check congr_is_Build_fo_record : forall n p1 p2, p1 = p2 -> forall b q1 q2, q1 = q2 -> is_Build_fo_record n p1 b q1= is_Build_fo_record n p2 b q2. Check congr_is_Build_pa_record : forall A PA n p1 p2, p1 = p2 -> forall b q1 q2, q1 = q2 -> is_Build_pa_record A PA n p1 b q1= is_Build_pa_record A PA n p2 b q2. Check congr_is_Build_pr_record : forall A pr n p1 p2, p1 = p2 -> forall b q1 q2, q1 = q2 -> is_Build_pr_record A pr n p1 b q1= is_Build_pr_record A pr n p2 b q2. Check congr_is_E1 : is_E1 = is_E1. coq-elpi-1.19.3/apps/derive/tests/test_param1_functor.v000066400000000000000000000054541451177652200230720ustar00rootroot00000000000000From elpi.apps Require Import derive.param1_functor. From elpi.apps.derive.tests Require Import test_derive_stdlib test_param1. Import test_derive_stdlib.Coverage. Import test_param1.Coverage. Module Coverage. Elpi derive.param1.functor is_empty. Elpi derive.param1.functor is_unit. Elpi derive.param1.functor is_peano. Elpi derive.param1.functor is_option. Elpi derive.param1.functor is_pair. Elpi derive.param1.functor is_seq. Elpi derive.param1.functor is_box_peano. Elpi derive.param1.functor is_rose. Elpi derive.param1.functor is_rose_p. Elpi derive.param1.functor is_rose_o. Elpi derive.param1.functor is_nest. Fail Elpi derive.param1.functor is_w. Elpi derive.param1.functor is_vect. Elpi derive.param1.functor is_dyn. Elpi derive.param1.functor is_zeta. Elpi derive.param1.functor is_beta. Elpi derive.param1.functor is_iota. Elpi derive.param1.functor is_large. Elpi derive.param1.functor is_prim_int. Elpi derive.param1.functor is_prim_float. Elpi derive.param1.functor is_fo_record. Elpi derive.param1.functor is_pa_record. Elpi derive.param1.functor is_pr_record. Elpi derive.param1.functor is_dep_record. Elpi derive.param1.functor is_enum. Fail Elpi derive.param1.functor param1.is_eq. Elpi derive.param1.functor is_bool. Elpi derive.param1.functor is_sigma_bool. Elpi derive.param1.functor is_ord. Elpi derive.param1.functor is_ord2. Elpi derive.param1.functor is_val. End Coverage. Local Notation func isT := (forall x, isT x -> isT x). Local Notation func1 isT := (forall A P Q, (forall y : A, P y -> Q y) -> forall x, isT A P x -> isT A Q x). Local Notation func2 isT := (forall A P Q, (forall y : A, P y -> Q y) -> forall A1 P1 Q1, (forall y : A1, P1 y -> Q1 y) -> forall x, isT A P A1 P1 x -> isT A Q A1 Q1 x). Import Coverage. Check is_empty_functor : func is_empty. Check is_unit_functor : func is_unit. Check is_peano_functor : func is_peano. Check is_option_functor : func1 is_option. Check is_pair_functor : func2 is_pair. Check is_seq_functor : func1 is_seq. Check is_rose_functor : func1 is_rose. Fail Check is_nest_functor : func1 is_nest. Fail Check is_w_functor. Check is_vect_functor : forall A P Q, (forall y : A, P y -> Q y) -> forall i p (v : vect A i), is_vect A P i p v -> is_vect A Q i p v. Check is_dyn_functor : func is_dyn. Check is_zeta_functor : func1 is_zeta. Check is_beta_functor : func1 is_beta. Check is_iota_functor : func is_iota. Check is_large_functor : func is_large. Check is_prim_int_functor : func is_prim_int. Check is_prim_float_functor : func is_prim_float. Check is_fo_record_functor : func is_fo_record. Check is_pa_record_functor : func1 is_pa_record. Check is_pr_record_functor : func1 is_pr_record. Check is_enum_functor : func is_enum. Check is_ord_functor : forall n pn, func (is_ord n pn). Check is_ord2_functor : forall n pn, func (is_ord2 n pn). Check is_val_functor : func is_val. coq-elpi-1.19.3/apps/derive/tests/test_param1_trivial.v000066400000000000000000000111631451177652200230560ustar00rootroot00000000000000From elpi.apps Require Import derive.param1_trivial. From elpi.apps Require Import test_derive_stdlib test_param1 test_param1_congr. Import derive.param1. (* for is_eq *) Import test_derive_stdlib.Coverage. Import test_param1.Coverage. Import test_param1_congr.Coverage. Module Coverage. Elpi derive.param1.trivial is_empty. Elpi derive.param1.trivial is_unit. Elpi derive.param1.trivial is_peano. Elpi derive.param1.trivial is_option. Elpi derive.param1.trivial is_pair. Elpi derive.param1.trivial is_seq. Elpi derive.param1.trivial is_box_peano. Fail Elpi derive.param1.trivial is_nest. Elpi derive.param1.trivial is_rose. Elpi derive.param1.trivial is_rose_p. Elpi derive.param1.trivial is_rose_o. Fail Elpi derive.param1.trivial is_w. Fail Elpi derive.param1.trivial is_vect. Fail Elpi derive.param1.trivial is_dyn. Elpi derive.param1.trivial is_zeta. Elpi derive.param1.trivial is_beta. Fail Elpi derive.param1.trivial is_iota. Elpi derive.param1.trivial is_large. Elpi derive.param1.trivial is_prim_int. Elpi derive.param1.trivial is_prim_float. Elpi derive.param1.trivial is_fo_record. Elpi derive.param1.trivial is_pa_record. Elpi derive.param1.trivial is_pr_record. Fail Elpi derive.param1.trivial is_dep_record. Elpi derive.param1.trivial is_enum. Elpi derive.param1.trivial is_bool. (* Elpi derive.param1.trivial is_eq. (* ad-hoc *) *) Elpi derive.param1.trivial is_sigma_bool. Elpi derive.param1.trivial is_ord. Elpi derive.param1.trivial is_ord2. Elpi derive.param1.trivial is_val. End Coverage. Import Coverage. Check is_empty_trivial : trivial empty is_empty. Check is_unit_trivial : trivial unit is_unit. Check is_peano_trivial : trivial peano is_peano. Check is_option_trivial : forall A P, trivial A P -> trivial (option A) (is_option A P). Check is_pair_trivial : forall A P, trivial A P -> forall B Q, trivial B Q -> trivial (pair A B) (is_pair A P B Q). Check is_seq_trivial : forall A P, trivial A P -> trivial (seq A) (is_seq A P). Check is_rose_trivial : forall A P, trivial A P -> trivial (rose A) (is_rose A P). Fail Check is_nest_trivial. Fail Check is_w_trivial : forall A P, trivial A P -> trivial (w A) (is_w A P). Fail Check is_vect_trivial : forall A P, trivial A P -> forall i pi, trivial (vect A i) (is_vect A P i pi). Fail Check is_dyn_trivial. Check is_zeta_trivial : forall A P, trivial A P -> trivial (zeta A) (is_zeta A P). Check is_beta_trivial : forall A P, trivial A P -> trivial (beta A) (is_beta A P). Fail Check is_iota_trivial. Check is_large_trivial : trivial large is_large. Check is_prim_int_trivial : trivial prim_int is_prim_int. Check is_prim_float_trivial : trivial prim_float is_prim_float. Check is_fo_record_trivial : trivial fo_record is_fo_record. Check is_pa_record_trivial : forall A P, trivial A P -> trivial (pa_record A) (is_pa_record A P). Check is_pr_record_trivial : forall A P, trivial A P -> trivial (pr_record A) (is_pr_record A P). Check is_enum_trivial : trivial enum is_enum. Check is_sigma_bool_trivial : trivial sigma_bool is_sigma_bool. Check is_ord_trivial : forall p px, trivial (ord p) (is_ord p px). Check is_ord2_trivial : forall p px, trivial (ord2 p) (is_ord2 p px). Check is_val_trivial : trivial val is_val. Check is_empty_inhab : full empty is_empty. Check is_unit_inhab : full unit is_unit. Check is_peano_inhab : full peano is_peano. Check is_option_inhab : forall A P, full A P -> full (option A) (is_option A P). Check is_pair_inhab : forall A P, full A P -> forall B Q, full B Q -> full (pair A B) (is_pair A P B Q). Check is_seq_inhab : forall A P, full A P -> full (seq A) (is_seq A P). Check is_rose_inhab : forall A P, full A P -> full (rose A) (is_rose A P). Fail Check is_nest_inhab. Fail Check is_w_inhab : forall A P, full A P -> full (w A) (is_w A P). Fail Check is_vect_inhab : forall A P, full A P -> forall i pi, full (vect A i) (is_vect A P i pi). Fail Check is_dyn_inhab. Check is_zeta_inhab : forall A P, full A P -> full (zeta A) (is_zeta A P). Check is_beta_inhab : forall A P, full A P -> full (beta A) (is_beta A P). Fail Check is_iota_inhab. Check is_large_inhab : full large is_large. Check is_prim_int_inhab : full prim_int is_prim_int. Check is_prim_float_inhab : full prim_float is_prim_float. Check is_fo_record_inhab : full fo_record is_fo_record. Check is_pa_record_inhab : forall A P, full A P -> full (pa_record A) (is_pa_record A P). Check is_pr_record_inhab : forall A P, full A P -> full (pr_record A) (is_pr_record A P). Check is_enum_inhab : full enum is_enum. Check is_sigma_bool_inhab : full sigma_bool is_sigma_bool. Check is_ord_inhab : forall p px, full (ord p) (is_ord p px). Check is_ord2_inhab : forall p px, full (ord2 p) (is_ord2 p px). Check is_val_inhab : full val is_val. coq-elpi-1.19.3/apps/derive/tests/test_param2.v000066400000000000000000000047051451177652200213310ustar00rootroot00000000000000From elpi.apps Require Import derive.param2. Set Uniform Inductive Parameters. Elpi derive.param2 unit. Elpi derive.param2 nat. Elpi derive.param2 list. (* The Parametricty plugin of K & L asks for an interactive proof here (the proof to be produced is the match over n in the nil branch) *) Definition nth T (x0 : T) := fix rec (n : nat) (l : list T) {struct n} : T := match l, n with | nil, _ => x0 | cons x _, 0 => x | cons _ xs, S m => rec m xs end. Elpi derive.param2 nth. Print nth_R. Inductive fin : nat -> Type := FO : fin 0 | FS : forall n : nat, fin n -> fin (S n). Elpi derive.param2 fin. Fixpoint fin_length n (v : fin n) := match v with FO => 0 | FS _ w => S (fin_length _ w) end. Elpi derive.param2 fin_length. Inductive vec (A : Type) : nat -> Type := vnil : vec 0 | vcons : A -> forall n : nat, vec n -> vec (S n). Elpi derive.param2 vec. Fixpoint vec_length (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param2 vec_length. Elpi derive.param2 eq. Elpi derive.param2 list_R. Fixpoint plus' m n := match n with 0 => m | S n => S (plus' m n) end. Elpi derive.param2 plus'. Elpi derive.param2 plus. Elpi derive.param2 prod. Elpi derive.param2 fst. Elpi derive.param2 snd. Elpi derive.param2 Nat.divmod. Elpi derive.param2 Nat.div. Definition test m n p q r := m + n + p + q + r. Elpi derive.param2 test. Definition vec_length_type := forall (A : Type) (n : nat), vec A n -> nat. Elpi derive.param2 vec_length_type. Definition vec_length_rec (vec_length : vec_length_type) (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param2 vec_length_rec. Definition nat2nat := nat -> nat. Definition nat2nat2nat := nat -> nat -> nat. Elpi derive.param2 nat2nat. Elpi derive.param2 nat2nat2nat. Elpi derive.param2 pred. Print pred_R. Check (pred_R : nat2nat_R pred pred). Fixpoint predn n := match n with 0 => 0 | S n => S (predn n) end. Elpi derive.param2 predn. Check (predn_R : nat2nat_R predn predn). Check (add_R : nat2nat2nat_R plus plus). Fixpoint quasidn n m := S (match n with 0 => m | S n => S (quasidn n m) end). Elpi derive.param2 quasidn. Fixpoint weirdn n := match n with S (S n) => S (weirdn n) | _ => 0 end. Elpi derive.param2 weirdn. Inductive bla : nat -> Type := Bla : nat -> bla 0 | Blu n : bla n -> bla 1. Elpi derive.param2 bla. Fixpoint silly (n : nat) := n. Elpi derive.param2 silly. coq-elpi-1.19.3/apps/derive/tests/test_projK.v000066400000000000000000000055331451177652200212340ustar00rootroot00000000000000From elpi.apps Require Import derive.projK. From elpi.apps.derive.tests Require Import test_derive_stdlib. Import test_derive_stdlib.Coverage. Module Coverage. Elpi derive.projK empty. Elpi derive.projK unit. Elpi derive.projK peano. Elpi derive.projK option. Elpi derive.projK pair. Elpi derive.projK seq. Elpi derive.projK box_peano. Elpi derive.projK rose. Elpi derive.projK rose_p. Elpi derive.projK rose_o. Elpi derive.projK nest. Elpi derive.projK w. Elpi derive.projK vect. Elpi derive.projK dyn. Elpi derive.projK zeta. Elpi derive.projK beta. Elpi derive.projK iota. Elpi derive.projK large. Elpi derive.projK prim_int. Elpi derive.projK prim_float. Elpi derive.projK fo_record. Elpi derive.projK pa_record. Elpi derive.projK pr_record. Elpi derive.projK dep_record. Elpi derive.projK enum. Elpi derive.projK eq. Elpi derive.projK bool. Elpi derive.projK sigma_bool. Elpi derive.projK ord. Elpi derive.projK val. End Coverage. Import Coverage. Check projSucc1 : peano -> peano -> peano. Check projSome1 : forall A, A -> option A -> A. Check projComma1 : forall A B, A -> B -> pair A B -> A. Check projComma2 : forall A B, A -> B -> pair A B -> B. Check projCons1 : forall A, A -> seq A -> seq A -> A. Check projCons2 : forall A, A -> seq A -> seq A -> seq A. Check projLeaf1 : forall A, A -> rose A -> A. Check projNode1 : forall A, seq (rose A) -> rose A -> seq (rose A). Check projConsN1 : forall A, A -> nest (pair A A) -> nest A -> A. Check projConsN2 : forall A, A -> nest (pair A A) -> nest A -> nest (pair A A). Check projvia1 : forall A, (A -> w A) -> w A -> (A -> w A). Check projVCons1 : forall A i, A -> forall j, vect A j -> vect A i -> A. Check projVCons2 : forall A i, A -> forall j, vect A j -> vect A i -> peano. Check projVCons3 : forall A i, A -> forall j, vect A j -> vect A i -> { w & vect A w }. Check projbox1 : forall T, T -> dyn -> Type. Check projbox2 : forall T, T -> dyn -> { T : Type & T }. Check projEnvelope1 : forall A, A -> A -> zeta A -> A. Check eq_refl 0 : projEnvelope1 nat 1 1 (Envelope nat 0 1) = 0. Check projEnvelope2 : forall A, A -> A -> zeta A -> A. Check eq_refl 0 : projEnvelope2 nat 1 1 (Envelope nat 1 0) = 0. Check projRedex1 : forall A, A -> beta A -> A. Check projWhy1 : forall n : peano, match n with | Zero => peano | Succ _ => unit end -> iota -> peano. Check projWhy2 : forall n : peano, match n with | Zero => peano | Succ _ => unit end -> iota -> { i : peano & match i with Zero => peano | Succ _ => unit end }. Check projPI1. Check projPF1. Check projBuild_fo_record1 : peano -> unit -> fo_record -> peano. Check projBuild_fo_record2 : peano -> unit -> fo_record -> unit. Check projBuild_pa_record2 : forall A, peano -> A -> pa_record A -> A. Check projBuild_pr_record2 : forall A, peano -> A -> pr_record A -> A. coq-elpi-1.19.3/apps/derive/tests/test_tag.v000066400000000000000000000034351451177652200207210ustar00rootroot00000000000000From elpi.apps Require Import derive.tag. From elpi.apps.derive.tests Require Import test_derive_stdlib. Import test_derive_stdlib.Coverage. Module Coverage. Elpi derive.tag empty. Elpi derive.tag unit. Elpi derive.tag peano. Elpi derive.tag option. Elpi derive.tag pair. Elpi derive.tag seq. Elpi derive.tag box_peano. Elpi derive.tag rose. Elpi derive.tag rose_p. Elpi derive.tag rose_o. Elpi derive.tag nest. Elpi derive.tag w. Elpi derive.tag vect. Elpi derive.tag dyn. Fail Elpi derive.tag zeta. Elpi derive.tag beta. Elpi derive.tag iota. Elpi derive.tag large. Elpi derive.tag prim_int. Elpi derive.tag prim_float. Elpi derive.tag fo_record. Elpi derive.tag pa_record. Elpi derive.tag pr_record. Elpi derive.tag dep_record. Elpi derive.tag enum. Elpi derive.tag eq. Elpi derive.tag bool. Elpi derive.tag sigma_bool. Elpi derive.tag ord. Elpi derive.tag ord2. Elpi derive.tag val. End Coverage. Import Coverage. Import PArith. Local Notation tag X := (X -> positive). Check empty_tag : tag empty. Check unit_tag : tag unit. Check peano_tag : tag peano. Check option_tag : forall A, tag (option A). Check pair_tag : forall A B, tag (pair A B). Check seq_tag : forall A, tag (seq A). Check rose_tag : forall A, tag (rose A). Check nest_tag : forall A, tag (nest A). Check w_tag : forall A, tag (w A). Check vect_tag : forall A i, tag (vect A i). Check dyn_tag : tag dyn. Fail Check zeta_tag : forall A, tag (zeta A). Check beta_tag : forall A, tag (beta A). Check iota_tag : tag iota. Check large_tag : tag large. Check prim_int_tag : tag prim_int. Check prim_float_tag : tag prim_float. Check pa_record_tag : forall A, tag (pa_record A). Check pr_record_tag : forall A, tag (pr_record A). Check ord_tag : forall p : peano, tag (ord p). Check ord2_tag : forall p : peano, tag (ord2 p). Check val_tag : tag val. coq-elpi-1.19.3/apps/derive/theories/000077500000000000000000000000001451177652200173735ustar00rootroot00000000000000coq-elpi-1.19.3/apps/derive/theories/derive.v000066400000000000000000000051701451177652200210430ustar00rootroot00000000000000(* Generates a module containing all the derived constants. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) (* since non-uniform inductive parameters are rarely used and the inference code from the kernel is not easily accessible, we require the user to be explicit about them, eg Inductive foo U1 U2 | NU1 NU2 := ... *) #[global] Set Uniform Inductive Parameters. (** The derive command The derive command can be invoked in two ways. - [derive ] - [derive Inductive ] [derive Record ] The first command runs all the derivations on an alerady declared inductive type named [] and all generated constants are named after the prefix [] (by default the inductive type name followed by [_]). Example: << derive nat. (* default prefix nat_ *) derive nat my_nat_stuff_. >> The second command takes as argument an inductive type declaration, it creates a module named after the inductive type and puts inside id both the inductive types and the output of the derivations. Example: << derive Inductive tickle A := stop | more : A -> tickle-> tickle. >> is equivalent to << Module tickle. Inductive tickle A := stop | more : A -> tickle-> tickle. derive tickle "". End tickle. Notation tickle := tickle.tickle. Notation stop := tickle.stop. Notation more := tickle.more. >> Both commands honor the [#[verbose]] attribute. If set they print all the derivations that are run, and if they fail or succeed. A derivation d can be skipped by using the [#[skip(d)]] attribute. A derivation different from d can be skipped [#[only(d)]] attribute. *) From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive Extra Dependency "derive.elpi" as derive. From elpi Require Import elpi. Elpi Command derive. Elpi Accumulate File derive_hook. Elpi Accumulate File derive. Elpi Accumulate lp:{{ % runs P in a context where Coq #[attributes] are parsed pred with-attributes i:prop. with-attributes P :- attributes A, coq.parse-attributes A [ att "verbose" bool, att "only" attmap, att "recursive" bool, ] Opts, !, Opts => P. main [str I] :- !, coq.locate I GR, with-attributes (derive.main GR tt _). main [indt-decl D] :- !, with-attributes (derive.decl+main D). main _ :- usage. usage :- coq.error "Usage: derive \n\tderive Inductive name Params : Arity := Constructors.". }}. Elpi Typecheck. Elpi Export derive. coq-elpi-1.19.3/apps/derive/theories/derive/000077500000000000000000000000001451177652200206515ustar00rootroot00000000000000coq-elpi-1.19.3/apps/derive/theories/derive/bcongr.v000066400000000000000000000034231451177652200223140ustar00rootroot00000000000000(* Generates congruence lemmas using reflect license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "injection.elpi" as injection. From elpi.apps.derive Extra Dependency "bcongr.elpi" as bcongr. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From Coq Require Export Bool. From elpi Require Export elpi. From elpi.apps Require Export derive. From elpi.apps Require Export derive.projK. Lemma eq_f (T1 : Type) (T2 : Type) (f : T1 -> T2) a b : a = b -> f a = f b. Proof. exact (fun h => eq_rect a (fun x => f a = f x) (eq_refl (f a)) b h). Defined. Register eq_f as elpi.derive.eq_f. Elpi Db derive.bcongr.db lp:{{ type bcongr-db constructor -> term -> prop. :name "bcongr-db:fail" bcongr-db K _ :- M is "derive.bcongr: can't find the boolean congruence for constructor " ^ {std.any->string K}, stop M. }}. (* standalone *) Elpi Command derive.bcongr. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.bcongr.db. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File injection. Elpi Accumulate File bcongr. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Prefix is Tname ^ "_", derive.bcongr.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.bcongr ". }}. Elpi Typecheck. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.bcongr.db. Elpi Accumulate derive File injection. Elpi Accumulate derive File bcongr. Elpi Accumulate derive lp:{{ dep1 "bcongr" "projK". derivation (indt T) N (derive "bcongr" (derive.bcongr.main T N) (derive.exists-indc T (K\bcongr-db K _))). }}. coq-elpi-1.19.3/apps/derive/theories/derive/cast.v000066400000000000000000000012441451177652200217730ustar00rootroot00000000000000(* Generates (once and forall) cast operators (trasport). license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "cast.elpi" as cast. From elpi Require Export elpi. Elpi Db derive.cast.db lp:{{ type cast-db int -> term -> prop. }}. Elpi Command derive.cast. Elpi Accumulate Db derive.cast.db. Elpi Accumulate File cast. Elpi Accumulate lp:{{ main [int N] :- derive.cast.main N. }}. Elpi Typecheck. Elpi derive.cast 2. Elpi derive.cast 3. Elpi derive.cast 4. Elpi derive.cast 5. Elpi derive.cast 6. Elpi derive.cast 7. coq-elpi-1.19.3/apps/derive/theories/derive/eq.v000066400000000000000000000035541451177652200214540ustar00rootroot00000000000000(* Generates equality tests. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "eq.elpi" as eq. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From Coq Require Import Bool. From elpi Require Import elpi. From elpi.apps Require Import derive. Register Coq.Numbers.Cyclic.Int63.PrimInt63.eqb as elpi.derive.eq_unit63. Register Coq.Floats.PrimFloat.eqb as elpi.derive.eq_float64. Elpi Db derive.eq.db lp:{{ % full resolution (composes with eq functions for parameters) type eq-db term -> term -> term -> prop. eq-db {{ lib:elpi.uint63 }} {{ lib:elpi.uint63 }} {{ lib:elpi.derive.eq_unit63 }} :- !. eq-db {{ lib:elpi.float64 }} {{ lib:elpi.float64 }} {{ lib:elpi.derive.eq_float64 }} :- !. :name "eq-db:fail" eq-db A B F :- ((whd1 A A1, B1 = B); (whd1 B B1, A1 = A)), !, eq-db A1 B1 F. eq-db A B _ :- M is "derive.eq: can't find the comparison function for terms of type " ^ {coq.term->string A} ^ " and " ^ {coq.term->string B} ^ " respectively", stop M. % quick access type eq-for inductive -> constant -> prop. }}. Elpi Command derive.eq. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eq.db. Elpi Accumulate File eq. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.eq.main GR O _. main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Id, O is Id ^ "_eq", derive.eq.main GR O _. main _ :- usage. usage :- coq.error "Usage: derive.eq []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.eq.db. Elpi Accumulate derive File eq. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix (derive "eq" (derive.eq.main T N) (eq-for T _)) :- N is Prefix ^ "eq". }}. coq-elpi-1.19.3/apps/derive/theories/derive/eqK.v000066400000000000000000000044461451177652200215700ustar00rootroot00000000000000(* Generates a branch of the correctness proof for comparison functions generated by derive.eq. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "discriminate.elpi" as discriminate. From elpi.apps.derive Extra Dependency "eqK.elpi" as eqK. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps Require Import derive.bcongr derive.eq derive.isK. Definition eq_axiom T eqb := forall (x y : T), Bool.Bool.reflect (x = y) (eqb x y). Definition eq_axiom_at T eqb (x : T) := forall y, Bool.Bool.reflect (x = y) (eqb x y). Definition eq_axiom_on T eqb (x y : T) := Bool.Bool.reflect (x = y) (eqb x y). Register eq_axiom as elpi.derive.eq_axiom. Register eq_axiom_at as elpi.derive.eq_axiom_at. Register eq_axiom_on as elpi.derive.eq_axiom_on. Lemma bool_discr : true = false -> forall T : Type, T. Proof. exact (fun h T => eq_rect true (fun x => match x with false => T | _ => True end) I false h). Qed. Register bool_discr as elpi.bool_discr. Elpi Db derive.eqK.db lp:{{ type eqK-db constructor -> term -> prop. :name "eqK-db:fail" eqK-db K _ :- M is "derive.eqK: can't find the eq.axiom for constructor " ^ {std.any->string K}, stop M. }}. (* standalone *) Elpi Command derive.eqK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File discriminate. Elpi Accumulate Db derive.bcongr.db. Elpi Accumulate Db derive.eq.db. Elpi Accumulate Db derive.eqK.db. Elpi Accumulate File eqK. Elpi Accumulate lp:{{ main [str I, str Prefix] :- !, coq.locate I (indt GR), derive.eqK.main GR Prefix _. main [str I] :- !, coq.locate I (indt GR), derive.eqK.main GR "eq_axiom_" _. main _ :- usage. usage :- coq.error "Usage: derive.eqK []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.eqK.db. Elpi Accumulate derive File discriminate. Elpi Accumulate derive File eqK. Elpi Accumulate derive lp:{{ dep1 "eqK" "bcongr". dep1 "eqK" "isK". derivation (indt T) Prefix (derive "eqK" (derive.eqK.main T N) (derive.exists-indc T (K\ eqK-db K _))) :- N is Prefix ^ "eq_axiom_". }}. coq-elpi-1.19.3/apps/derive/theories/derive/eqOK.v000066400000000000000000000033151451177652200217010ustar00rootroot00000000000000(* Generates the final, correctness lemma, for equality tests by combinig the output of eqcorrect and param1_inhab. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param1.elpi" as param1. From elpi.apps.derive Extra Dependency "eqOK.elpi" as eqOK. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps Require Import derive.param1 derive.param1_trivial derive.eqK derive.eqcorrect. Elpi Db derive.eqOK.db lp:{{ pred eqOK-done i:inductive. }}. (* standalone *) Elpi Command derive.eqOK. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate Db derive.eqcorrect.db. Elpi Accumulate Db derive.eqOK.db. Elpi Accumulate File eqOK. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.eqOK.main GR O _. main [str I] :- !, coq.locate I (indt GR), Name is {coq.gref->id (indt GR)} ^ "_eq_OK", derive.eqOK.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.eqOK []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File eqOK. Elpi Accumulate derive Db derive.eqOK.db. Elpi Accumulate derive lp:{{ dep1 "eqOK" "eqcorrect". dep1 "eqOK" "param1_trivial". derivation (indt T) Prefix (derive "eqOK" (derive.eqOK.main T N) (eqOK-done T)) :- N is Prefix ^ "eq_OK". }}. coq-elpi-1.19.3/apps/derive/theories/derive/eqOK_trivial.v000066400000000000000000000030471451177652200234350ustar00rootroot00000000000000(* Draft: trivil eq_axiom (needed for indexes) license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From mathcomp Require Import all_ssreflect. From elpi.apps Require Import elpi. Definition transp {T} (Ctx : T -> Type) {t1 t2} (e : t2 = t1) : Ctx t1 -> Ctx t2. Proof. by case: _/e. Defined. Axiom dep_fun_ext : forall T (P : T -> Type) (f g: forall t:T, P t), (forall x, f x = g x) -> f = g. Lemma reflect_irrelevance (T : eqType) (x y : T) b (p1 p2 : reflect (x = y) b) : p1 = p2. Proof. case: p2 p1 => {b} [e| ne] r. refine (match r as r in reflect _ t return forall p : t = true, r = transp (reflect (x = y)) p (ReflectT (x = y) e) with | ReflectT e' => _ | ReflectF ne' => _ end (erefl true)) => // p {r}. rewrite (eq_irrelevance p (erefl true)) {p}. congr (ReflectT (x = y)). by apply: eq_irrelevance. refine (match r as r in reflect _ t return forall p : t = false, r = transp (reflect (x = y)) p (ReflectF (x = y) ne) with | ReflectT e' => _ | ReflectF ne' => _ end (erefl false)) => // p {r}. rewrite (eq_irrelevance p (erefl false)) {p}. congr (ReflectF (x = y)). apply: dep_fun_ext. by case/ne. Qed. Lemma eq_axiom_trivial (a : eqType) fa : full a (eq_axiom a fa) -> trivial a (eq_axiom a fa). Proof. rewrite /eq_axiom /full. move=> p1 x; exists (p1 x) => p2. apply: dep_fun_ext => w. apply: reflect_irrelevance. Qed. coq-elpi-1.19.3/apps/derive/theories/derive/eqType_ast.v000066400000000000000000000030131451177652200231530ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps.derive Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. Elpi Db derive.eqType.db lp:{{ kind arguments type. kind trm type. kind eqType type. kind constructor type. type app gref -> trm -> list trm -> trm. type global gref -> trm. type regular trm -> arguments -> arguments. type irrelevant trm -> arguments -> arguments. type dependent trm -> (trm -> arguments) -> arguments. type stop trm -> arguments. type type-param (trm -> eqType) -> eqType. type value-param trm -> (trm -> eqType) -> eqType. type inductive inductive -> (trm -> list constructor) -> eqType. type constructor constructor -> arguments -> constructor. pred eqType i:inductive, o:eqType. }}. Definition arrow T1 T2 := T1 -> T2. Register arrow as elpi.derive.arrow. Definition apply {T1 T2} (f : T1 -> T2) x := f x. Register apply as elpi.derive.apply. (* standalone *) Elpi Command derive.eqType.ast. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate File eqType. Elpi Accumulate lp:{{ main [str S] :- std.assert! (coq.locate S (indt I)) "derive.eqType.ast: not an inductive", derive.eqType.ast.main I _. }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.eqType.db. Elpi Accumulate derive File eqType. Elpi Accumulate derive lp:{{ derivation (indt T) _ (derive "eqType_ast" (derive.eqType.ast.main T) (eqType T _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/eqb.v000066400000000000000000000037201451177652200216110ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive derive.param1. From Coq Require Import ssrbool ssreflect Uint63. From Coq Require Import PArith. From elpi.apps.derive Extra Dependency "fields.elpi" as fields. From elpi.apps.derive Extra Dependency "eqb.elpi" as eqb. From elpi.apps.derive Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. Require Import eqb_core_defs. Require Import eqType_ast tag fields. Register eqb_body as elpi.derive.eqb_body. Elpi Db derive.eqb.db lp:{{ pred eqb-done o:gref. pred eqb-for o:term, % type1 o:term, % type2 o:term. % comparison function pred eqb-fields o:term, % type1 o:term, % type2 o:term. % eq_fields_type eqb-for {{ PrimFloat.float }} {{ PrimFloat.float }} {{ PrimFloat.eqb }}. eqb-for {{ PrimInt63.int }} {{ PrimInt63.int }} {{ PrimInt63.eqb }}. :name "eqb-for:whd" eqb-for T1 T2 X :- whd1 T1 T1', !, eqb-for T1' T2 X. eqb-for T1 T2 X :- whd1 T2 T2', !, eqb-for T1 T2' X. }}. (* standalone *) Elpi Command derive.eqb. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.tag.db. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.fields.db. Elpi Accumulate Db derive.eqb.db. Elpi Accumulate File fields. Elpi Accumulate File eqb. Elpi Accumulate File eqType. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.eqb.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.eqb ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.eqb.db. Elpi Accumulate derive File eqb. Elpi Accumulate derive lp:{{ dep1 "eqb" "fields". derivation (indt T) Prefix (derive "eqb" (derive.eqb.main (indt T) Prefix) (eqb-done (indt T))). derivation (const C) Prefix (derive "eqb-alias" (derive.eqb.main (const C) Prefix) (eqb-done (const C))). }}. coq-elpi-1.19.3/apps/derive/theories/derive/eqbOK.v000066400000000000000000000030301451177652200220350ustar00rootroot00000000000000(* Generates soudness proofs given correctness and reflexivity. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) Require Import eqb_core_defs. Require Import tag eqType_ast fields eqb eqbcorrect derive. From elpi.apps.derive Extra Dependency "eqbOK.elpi" as eqbOK. From elpi.apps.derive Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. Elpi Db derive.eqbOK.db lp:{{ pred eqbok-for o:gref, o:constant. }}. (* standalone *) Elpi Command derive.eqbOK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eqb.db. Elpi Accumulate Db derive.eqbcorrect.db. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.eqbOK.db. Elpi Accumulate File eqbOK. Elpi Accumulate File eqType. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.eqbOK.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.eqbOK ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File eqbOK. Elpi Accumulate derive Db derive.eqbOK.db. Elpi Accumulate derive lp:{{ dep1 "eqbOK" "eqbcorrect". derivation (indt T) Prefix (derive "eqbOK" (derive.eqbOK.main (indt T) Prefix) (eqbok-for (indt T) _)). dep1 "eqbOK-alias" "eqbcorrect-alias". derivation (const T) Prefix (derive "eqbOK-alias" (derive.eqbOK.main (const T) Prefix) (eqbok-for (const T) _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/eqb_core_defs.v000066400000000000000000000103311451177652200236160ustar00rootroot00000000000000Require Import Eqdep_dec. Require Import PArith. Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Open Scope positive_scope. Section Section. Context {A:Type}. Definition eqb_correct_on (eqb : A -> A -> bool) (a1:A) := forall a2, eqb a1 a2 -> a1 = a2. Definition eqb_refl_on (eqb : A -> A -> bool) (a:A) := is_true (eqb a a). Definition eqb_correct (eqb : A -> A -> bool) := forall (a1:A), eqb_correct_on eqb a1. Definition eqb_reflexive (eqb : A -> A -> bool) := forall (a:A), eqb_refl_on eqb a. Lemma iffP2 (f : A -> A -> bool) (H1 : eqb_correct f) (H2 : eqb_reflexive f) (x1 x2 : A) : reflect (x1 = x2) (f x1 x2). Proof. apply (iffP idP);[ apply H1 | move->; apply H2 ]. Qed. Definition eqax_on (eqb : A -> A -> bool) (a1:A) := forall a2, reflect (a1 = a2) (eqb a1 a2). End Section. Section Section. Context {A B:Type}. Variable tagA : A -> positive. Variable tagB : B -> positive. Variable fields_tA : positive -> Type. Variable fields_tB : positive -> Type. Variable fieldsA : forall a, fields_tA (tagA a). Variable fieldsB : forall a, fields_tB (tagB a). Variable constructA : forall t, fields_tA t -> option A. Variable constructB : forall t, fields_tB t -> option B. Variable constructPA : forall a, constructA (fieldsA a) = Some a. Variable constructPB : forall a, constructB (fieldsB a) = Some a. Variable eqb_fields : forall t, fields_tA t -> fields_tB t -> bool. Definition eqb_body (t1:positive) (f1:fields_tA t1) (x2:B) := let t2 := tagB x2 in match Pos.eq_dec t2 t1 with | left heq => let f2 : fields_tB t2 := fieldsB x2 in @eqb_fields t1 f1 (match heq with eq_refl => f2 end) | right _ => false end. #[global] Arguments eqb_body _ _ _ /. End Section. Section Section. Context {A:Type}. Variable tag : A -> positive. Variable fields_t : positive -> Type. Variable fields : forall a, fields_t (tag a). Variable construct : forall t, fields_t t -> option A. Variable constructP : forall a, construct (fields a) = Some a. Variable eqb_fields : forall t, fields_t t -> fields_t t -> bool. Definition eqb_fields_correct_on (a:A) := forall f : fields_t (tag a), eqb_fields (fields a) f -> Some a = construct f. Lemma eqb_body_correct a1 : eqb_fields_correct_on a1 -> forall a2, eqb_body fields eqb_fields (fields a1) a2 -> a1 = a2. Proof. move=> hf a2 hb. suff : Some a1 = Some a2 by move=> [->]. rewrite -(constructP a2); move: hb; rewrite /eqb_body. case: Pos.eq_dec => // heq. move: (tag a2) heq (fields a2) => t2 ?; subst t2 => f2 /=; apply hf. Qed. Definition eqb_fields_refl_on (a:A) := eqb_fields (fields a) (fields a). Lemma eqb_body_refl a : eqb_fields_refl_on a -> eqb_body fields eqb_fields (fields a) a. Proof. pose h := constructP. (* dummy dependence to have the same type as eqb_body_correct *) rewrite /eqb_body => hf. case: Pos.eq_dec => // heq. have -> /= := Eqdep_dec.UIP_dec Pos.eq_dec heq eq_refl; apply hf. Qed. Inductive blist := bnil | bcons (b : bool) (bs : blist). Fixpoint eqb_refl_statement (acc : bool) (l : blist) {struct l} := match l with | bnil => acc = true | bcons b bs => b = true -> eqb_refl_statement (b && acc) bs end. Lemma eqb_refl_statementP l : eqb_refl_statement true l. Proof. elim: l => //= b l hrec ->; apply hrec. Qed. Fixpoint implies (l : blist) (P : Prop) : Prop := match l with | bnil => P | bcons b bs => b = true -> implies bs P end. Fixpoint allr (l : blist) := match l with | bnil => true | bcons b bs => b && allr bs end. Lemma impliesP (l:blist) (P:Prop) : implies l P -> allr l = true -> P. Proof. by elim: l => //= b l hrec hall /andP[/hall]. Qed. Inductive tlist := tnil | tcons (T : Type) (TS : tlist). Fixpoint p_type (T : tlist) := match T with | tnil => Prop | tcons T Ts => T -> p_type Ts end. Fixpoint eq_ind_r_n (T : tlist) : p_type T -> p_type T -> Prop := match T return p_type T -> p_type T -> Prop with | tnil => fun p q => p -> q | tcons T Ts => fun p q => forall (x y : T), x = y -> @eq_ind_r_n Ts (p x) (q y) end. Lemma eq_ind_r_nP (T : tlist) (p : p_type T) : @eq_ind_r_n T p p. Proof. elim: T p => //= T Ts hrec f a1 a2 ->; apply hrec. Qed. End Section. coq-elpi-1.19.3/apps/derive/theories/derive/eqbcorrect.v000066400000000000000000000065641451177652200232040ustar00rootroot00000000000000From Coq Require Import ssreflect ssrfun ssrbool Eqdep_dec. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps.derive Require Import induction param1_functor param1_trivial eqb_core_defs tag fields eqb. From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param1.elpi" as param1. From elpi.apps.derive Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive Extra Dependency "eqbcorrect.elpi" as eqbcorrect. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. Module Export exports. Export ssreflect ssrbool eqb_core_defs. (* go ask the ltac gurus... *) Ltac solver_regular_or_dependent := match reverse goal with | View : @eqb_correct_on _ ?f ?y |- is_true (?f ?y ?x && _) -> _ => case/andP => /View => ? {View}; subst x end. Ltac solver_irrelevant := match goal with | p1 : ?x = true , p2 : ?x = true |- _ => let top := fresh "x" in have top := @Eqdep_dec.UIP_dec bool Bool.bool_dec _ _ p1 p2; subst p1 end. Ltac eqb_correct_on__solver := let x := fresh "x" in case=> [^ x] /=; by repeat (solver_regular_or_dependent || solver_irrelevant). Ltac eqb_refl_on__solver := by rewrite /eqb_fields_refl_on /=; repeat ((apply /andP; split) || reflexivity || assumption). End exports. Lemma uint63_eqb_correct i : eqb_correct_on PrimInt63.eqb i. Proof. by move=> j; case: (Uint63.eqb_spec i j); case: PrimInt63.eqb. Qed. Lemma uint63_eqb_refl i : eqb_refl_on PrimInt63.eqb i. Proof. by case: (Uint63.eqb_spec i i) => _ H; exact: H. Qed. Elpi Db derive.eqbcorrect.db lp:{{ pred eqcorrect-for o:gref, o:constant, % correct o:constant. % reflexive eqcorrect-for {{:gref PrimInt63.int }} C R :- {{:gref uint63_eqb_correct}} = const C, {{:gref uint63_eqb_refl}} = const R. :index(2) pred correct-lemma-for i:term, o:term. correct-lemma-for {{ PrimInt63.int }} {{ @uint63_eqb_correct }}. :index(2) pred refl-lemma-for i:term, o:term. refl-lemma-for {{ PrimInt63.int }} {{ @uint63_eqb_refl }}. }}. (* standalone *) Elpi Command derive.eqbcorrect. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.tag.db. Elpi Accumulate Db derive.eqb.db. Elpi Accumulate Db derive.fields.db. Elpi Accumulate Db derive.eqbcorrect.db. Elpi Accumulate Db derive.induction.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File eqbcorrect. Elpi Accumulate File paramX. Elpi Accumulate File param1. Elpi Accumulate File eqType. Elpi Accumulate Db derive.param1.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.eqbcorrect.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.eqbcorrect ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File eqbcorrect. Elpi Accumulate derive Db derive.eqbcorrect.db. Elpi Accumulate derive lp:{{ dep1 "eqbcorrect" "eqb". dep1 "eqbcorrect" "induction". dep1 "eqbcorrect" "param1_inhab". derivation (indt T) Prefix (derive "eqbcorrect" (derive.eqbcorrect.main (indt T) Prefix) (eqcorrect-for (indt T) _ _)). dep1 "eqbcorrect-alias" "eqb-alias". derivation (const C) Prefix (derive "eqbcorrect-alias" (derive.eqbcorrect.main (const C) Prefix) (eqcorrect-for (const C) _ _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/eqcorrect.v000066400000000000000000000046161451177652200230360ustar00rootroot00000000000000(* Generates correctness proofs for comparison functions generated by derive.eq. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "eqcorrect.elpi" as eqcorrect. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps Require Import derive.eq derive.induction derive.eqK derive.param1. From Coq Require Import ssreflect Uint63. Lemma uint63_eq_correct i : is_uint63 i -> eq_axiom_at PrimInt63.int PrimInt63.eqb i. Proof. move=> _ j; case: (Uint63.eqb_spec i j); case: PrimInt63.eqb => [-> // _|_ abs]; [ by constructor | by constructor=> /abs ]. Qed. Register uint63_eq_correct as elpi.derive.uint63_eq_correct. Elpi Db derive.eqcorrect.db lp:{{ type eqcorrect-db gref -> term -> prop. eqcorrect-db X {{ lib:elpi.derive.uint63_eq_correct }} :- {{ lib:elpi.uint63 }} = global X, !. eqcorrect-db X _ :- {{ lib:elpi.float64 }} = global X, !, stop "float64 comparison is not syntactic". :name "eqcorrect-db:fail" eqcorrect-db T _ :- M is "derive.eqcorrect: can't find the correctness proof for the comparison function on " ^ {coq.gref->string T}, stop M. }}. (* standalone *) Elpi Command derive.eqcorrect. Elpi Accumulate Db derive.param1.db. (* TODO: understand which other db needs this *) Elpi Accumulate Db derive.induction.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate Db derive.eq.db. Elpi Accumulate Db derive.eqK.db. Elpi Accumulate Db derive.eqcorrect.db. Elpi Accumulate File eqcorrect. Elpi Accumulate lp:{{ main [str I, str Name] :- !, coq.locate I (indt GR), derive.eqcorrect.main GR Name _. main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) ID, Name is ID ^ "_eq_correct", derive.eqcorrect.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.eqcorrect []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File derive_hook. Elpi Accumulate derive File eqcorrect. Elpi Accumulate derive Db derive.eqcorrect.db. Elpi Accumulate derive lp:{{ dep1 "eqcorrect" "induction". dep1 "eqcorrect" "eq". dep1 "eqcorrect" "eqK". derivation (indt T) Prefix (derive "eqcorrect" (derive.eqcorrect.main T N) (eqcorrect-db (indt T) _)) :- N is Prefix ^ "eq_correct". }}. coq-elpi-1.19.3/apps/derive/theories/derive/experimental.v000066400000000000000000000004661451177652200235430ustar00rootroot00000000000000(* Experimental set of derivations license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps Require Export derive. From elpi.apps Require Export derive.invert derive.idx2inv . Elpi Typecheck derive. coq-elpi-1.19.3/apps/derive/theories/derive/fields.v000066400000000000000000000031341451177652200223070ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive. From Coq Require Import PArith. From elpi.apps Require Export derive.eqType_ast derive.tag. From elpi.apps.derive Extra Dependency "fields.elpi" as fields. From elpi.apps.derive Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. Register unit as elpi.derive.unit. Local Open Scope positive_scope. Elpi Db derive.fields.db lp:{{ % this is how one registers the fields_t, fields and construct[P] % constants to an inductive and let other elpi commands use that piece of info pred fields-for o:inductive, o:constant, % fields_t o:constant, % fields o:constant, % construct o:constant. % constructP pred box-for o:constructor, o:inductive, o:constructor. }}. (* standalone *) Elpi Command derive.fields. Elpi Accumulate File derive_hook. Elpi Accumulate File fields. Elpi Accumulate File eqType. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.tag.db. Elpi Accumulate Db derive.fields.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Prefix is Tname ^ "_", derive.fields.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.fields []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File fields. Elpi Accumulate derive Db derive.fields.db. Elpi Accumulate derive lp:{{ dep1 "fields" "tag". dep1 "fields" "eqType_ast". derivation (indt T) Prefix (derive "fields" (derive.fields.main T Prefix) (fields-for T _ _ _ _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/idx2inv.v000066400000000000000000000033321451177652200224240ustar00rootroot00000000000000(* Generates lemmas linking an inductive with indexes and its structural copy without indexes but equations instead. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param1_functor.elpi" as param1_functor. From elpi.apps.derive Extra Dependency "idx2inv.elpi" as idx2inv. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Export elpi. From elpi.apps Require Export derive. From elpi.apps Require Export derive.param1 derive.param1_functor derive.invert. Elpi Db derive.idx2inv.db lp:{{ type idx2inv-db inductive -> inductive -> constant -> constant -> prop. }}. (* standalone *) Elpi Command derive.idx2inv. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File param1_functor. Elpi Accumulate Db derive.invert.db. Elpi Accumulate Db derive.idx2inv.db. Elpi Accumulate File idx2inv. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.idx2inv.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.idx2inv.main GR "_to_" _. main _ :- usage. usage :- coq.error "Usage: derive.idx2inv []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.idx2inv.db. Elpi Accumulate derive File idx2inv. Elpi Accumulate File paramX. Elpi Accumulate derive lp:{{ dep1 "idx2inv" "invert". derivation (indt T) _ (derive "idx2inv" (derive.idx2inv.main T "_to_") (idx2inv-db T _ _ _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/induction.v000066400000000000000000000031441451177652200230360ustar00rootroot00000000000000(* Generates the induction principle. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param1.elpi" as param1. From elpi.apps.derive Extra Dependency "induction.elpi" as induction. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive derive.param1 derive.param1_functor. Elpi Db derive.induction.db lp:{{ pred induction-db i:inductive, o:term. :name "induction-db:fail" induction-db T _ :- M is "derive.induction: can't find the induction principle for " ^ {std.any->string T}, stop M. }}. (* standalone *) Elpi Command derive.induction. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate Db derive.induction.db. Elpi Accumulate File induction. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), Name is {coq.gref->id (indt GR)} ^ "_", derive.induction.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.induction ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File induction. Elpi Accumulate derive Db derive.induction.db. Elpi Accumulate derive lp:{{ dep1 "induction" "param1_functor". derivation (indt T) N (derive "induction" (derive.induction.main T N) (induction-db T _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/invert.v000066400000000000000000000022461451177652200223530ustar00rootroot00000000000000(* Generates inversion lemmas by encoding indexes with equations and non uniform parameters. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "invert.elpi" as invert. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Export elpi. From elpi.apps Require Export derive. Elpi Db derive.invert.db lp:{{ type invert-db gref -> gref -> prop. }}. Elpi Command derive.invert. Elpi Accumulate Db derive.invert.db. Elpi Accumulate File invert. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.invert.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.invert.main GR "_inv" _. main _ :- usage. usage :- coq.error "Usage: derive.invert []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File invert. Elpi Accumulate derive Db derive.invert.db. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix (derive "invert" (derive.invert.main T N) (invert-db (indt T) _)) :- N is Prefix ^ "inv". }}. coq-elpi-1.19.3/apps/derive/theories/derive/isK.v000066400000000000000000000027551451177652200215770ustar00rootroot00000000000000(* For each constructor K the function isK returns true iff it is applied to K. These helpers are use to implement "discriminate". license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "isK.elpi" as isK. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. (* Links the @gref of the constructor K to the isK constant *) Elpi Db derive.isK.db lp:{{ type isK-db constructor -> term -> prop. :name "isK-db:fail" isK-db K _ :- M is "No isK entry for constructor " ^ {std.any->string K} ^ ". Did you run derive.isK?", stop M. }}. Elpi Command derive.isK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File isK. Elpi Accumulate lp:{{ main [str I,str O] :- !, coq.locate I (indt GR), derive.isK.main GR O _. main [str I] :- !, coq.locate I (indt GR), Prefix is {coq.gref->id (indt GR)} ^ "_is_", derive.isK.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.isK []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.isK.db. Elpi Accumulate derive File isK. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix (derive "isK" (derive.isK.main T N) (derive.exists-indc T (K\ isK-db K _))) :- N is Prefix ^ "isk_". }}. coq-elpi-1.19.3/apps/derive/theories/derive/legacy.v000066400000000000000000000005421451177652200223050ustar00rootroot00000000000000(* Legacy set of derivations license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps Require Export derive. From elpi.apps Require Export derive.projK derive.isK derive.eq derive.eqK derive.bcongr derive.eqOK . Elpi Typecheck derive. coq-elpi-1.19.3/apps/derive/theories/derive/lens.v000066400000000000000000000033041451177652200220010ustar00rootroot00000000000000(* A lens, to see better. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "lens.elpi" as lens. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. (* Coq stdlib has no lens data type so we declare one here. To override with your own "copy", use Register as below *) Local Set Primitive Projections. Record Lens (a b c d : Type) : Type := mkLens { view : a -> c ; over : (c -> d) -> a -> b }. Register mkLens as elpi.derive.lens.make. Arguments view {_ _ _ _} _ _. Arguments over {_ _ _ _} _ _ _. Definition set {a b c d} (l : Lens a b c d) new := over l (fun _ => new). Register set as elpi.derive.lens.set. Register view as elpi.derive.lens.view. (* Links the record, a field name and the lens focusing on that field *) Elpi Db derive.lens.db lp:{{ pred lens-db o:inductive, o:string, o:constant. }}. (* standalone command *) Elpi Command derive.lens. Elpi Accumulate File derive_hook. Elpi Accumulate File lens. Elpi Accumulate Db derive.lens.db. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.lens.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.lens.main GR "_" _. main _ :- usage. usage :- coq.error "Usage: derive.lens []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.lens.db. Elpi Accumulate derive File lens. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix (derive "lens" (derive.lens.main T N) (lens-db T _ _)) :- N is Prefix ^ "_". }}. coq-elpi-1.19.3/apps/derive/theories/derive/lens_laws.v000066400000000000000000000045511451177652200230340ustar00rootroot00000000000000(* Equations for lenses license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "lens_laws.elpi" as lens_laws. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive.lens. Definition view_set_on {a c} (l : Lens a a c c) r := forall x, view l (set l x r) = x. Definition view_set {a c} (l : Lens a a c c) := forall r, view_set_on l r. Definition set_set_on {a c d} (l : Lens a a c d) r := forall x y, set l y (set l x r) = set l y r. Definition set_set {a c d} (l : Lens a a c d) := forall r, set_set_on l r. Definition set_view_on {a c} (l : Lens a a c c) r := set l (view l r) r = r. Definition set_view {a c} (l : Lens a a c c) := forall r, set_view_on l r. Definition exchange_on {a b d e f} (l1 : Lens a a b d) (l2 : Lens a a e f) r := forall x y, set l1 x (set l2 y r) = set l2 y (set l1 x r). Definition exchange {a b d e f} (l1 : Lens a a b d) (l2 : Lens a a e f) := forall r, exchange_on l1 l2 r. Register view_set as elpi.derive.lens.view_set. Register view_set_on as elpi.derive.lens.view_set_on. Register set_set as elpi.derive.lens.set_set. Register set_set_on as elpi.derive.lens.set_set_on. Register set_view as elpi.derive.lens.set_view. Register set_view_on as elpi.derive.lens.set_view_on. Register exchange as elpi.derive.lens.exchange. Register exchange_on as elpi.derive.lens.exchange_on. Elpi Db derive.lens_laws.db lp:{{ pred lens-laws-done i:inductive. }}. (* standalone *) Elpi Command derive.lens_laws. Elpi Accumulate File derive_hook. Elpi Accumulate File lens_laws. Elpi Accumulate Db derive.lens.db. Elpi Accumulate Db derive.lens_laws.db. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.lens-laws.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.lens-laws.main GR "_" _. main _ :- usage. usage :- coq.error "Usage: derive.lens_laws []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File lens_laws. Elpi Accumulate derive Db derive.lens_laws.db. Elpi Accumulate derive lp:{{ dep1 "lens_laws" "lens". derivation (indt T) Prefix (derive "lens_laws" (derive.lens-laws.main T N) (lens-laws-done T)) :- N is Prefix ^ "_". }}. coq-elpi-1.19.3/apps/derive/theories/derive/map.v000066400000000000000000000023511451177652200216160ustar00rootroot00000000000000(* A map over a container. For non containers it produces the copy function. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "map.elpi" as map. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. (* Links the source and target type with the corresponding map function, eg. "map-db (list A) (list B) (list_map f_A_B)" *) Elpi Db derive.map.db lp:{{ pred map-done i:inductive. pred map-db i:term, i:term, o:term. }}. (* standalone command *) Elpi Command derive.map. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.map.db. Elpi Accumulate File map. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), O is {coq.gref->id (indt GR)} ^ "_", derive.map.main GR O _. main _ :- usage. usage :- coq.error "Usage: derive.map ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.map.db. Elpi Accumulate derive File map. Elpi Accumulate derive lp:{{ derivation (indt T) N (derive "map" (derive.map.main T N) (map-done T)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/param1.v000066400000000000000000000066251451177652200222320ustar00rootroot00000000000000(* Unary parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param1.elpi" as param1. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. Definition contractible T := { x : T & forall y, @eq T x y }. Register contractible as elpi.derive.contractible. Definition contracts T P (x : T) w u := (@existT (P x) (fun u : P x => forall v : P x,@eq (P x) u v) w u). Register contracts as elpi.derive.contracts. Definition full T P := forall x : T, P x. Register full as elpi.derive.full. Definition trivial T P := forall x : T, contractible (P x). Register trivial as elpi.derive.trivial. Definition trivial_full T P (e : trivial T P) (x : T) : P x := projT1 (e x). Register trivial_full as elpi.derive.trivial_full. Definition trivial_uniq T P (e : trivial T P) (x : T) (p : P x) : trivial_full T P e x = p := projT2 (e x) p. Register trivial_uniq as elpi.derive.trivial_uniq. (* To be removed. Like the param1-db below, but readable from Coq *) Class reali_db {X XR : Type} (x : X) (xR : XR) := store_reali {}. Class reali {X : Type} {XR : X -> Type} (x : X) (xR : XR x) := Reali {}. Register store_reali as param1.store_reali. Inductive is_uint63 : PrimInt63.int -> Type := uint63 (i : PrimInt63.int) : is_uint63 i. Register is_uint63 as elpi.derive.is_uint63. Inductive is_float64 : PrimFloat.float -> Type := float64 (f : PrimFloat.float ) : is_float64 f. Register is_float64 as elpi.derive.is_float64. (* Links a term (constant, inductive type, inductive constructor) with its parametricity translation *) Elpi Db derive.param1.db lp:{{ pred reali-done i:gref. :index(3) pred reali i:term, o:term. reali {{ lib:elpi.uint63 }} {{ lib:elpi.derive.is_uint63 }} :- !. reali {{ lib:elpi.float64 }} {{ lib:elpi.derive.is_float64 }} :- !. :name "reali:fail" reali X _ :- M is "derive.param1: No unary parametricity translation for " ^ {coq.term->string X}, stop M. type realiR term -> term -> prop. realiR {{ lib:elpi.uint63 }} {{ lib:elpi.derive.is_uint63 }} :- !. realiR {{ lib:elpi.float64 }} {{ lib:elpi.derive.is_float64 }} :- !. :name "realiR:fail" realiR T TR :- M is "derive.param1: No unary parametricity translation linking " ^ {coq.term->string T} ^ " and " ^ {coq.term->string TR}, stop M. }}. (* standalone *) Elpi Command derive.param1. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, derive.param1.main GR "" _. main _ :- usage. usage :- coq.error "Usage: derive.param1 ". }}. Elpi Typecheck. Module Export exports. Elpi derive.param1 eq. End exports. Register is_eq as elpi.derive.is_eq. (* hook into derive *) Elpi Accumulate derive File paramX. Elpi Accumulate derive File param1. Elpi Accumulate derive Db derive.param1.db. Elpi Accumulate derive lp:{{ pred derive.on_param1 i:inductive, i:(inductive -> string -> list prop -> prop), i:string, o:list prop. derive.on_param1 T F N C :- reali (global (indt T)) (global (indt P)), !, F P N C. derivation T N (derive "param1" (derive.param1.main T N ) (reali-done T)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/param1_congr.v000066400000000000000000000031551451177652200234150ustar00rootroot00000000000000(* Given an inductive type I and its unary parametricity translation is_I it generates for is constructor is_K a lemma like px = qx -> is_K x px .. = is_K x qx .. where px is the extra argument (about x) introduces by the parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param1_congr.elpi" as param1_congr. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Export elpi. From elpi.apps Require Export derive.param1. Elpi Db derive.param1.congr.db lp:{{ type param1-congr-db constructor -> term -> prop. }}. Elpi Command derive.param1.congr. Elpi Accumulate File paramX. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate File param1_congr. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.param1.congr.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.param1.congr.main GR "congr_" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.congr []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File param1_congr. Elpi Accumulate derive Db derive.param1.congr.db. Elpi Accumulate derive lp:{{ dep1 "param1_congr" "param1". derivation (indt T) _ (derive "param1_congr" (derive.on_param1 T derive.param1.congr.main "congr_") (derive.on_param1 T (T\_\_\derive.exists-indc T (K\ param1-congr-db K _)) _ _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/param1_functor.v000066400000000000000000000031431451177652200237620ustar00rootroot00000000000000(* Functorial property of params in param1 translation. Inductive I A PA : A -> Type := K : forall a b, I A PA a. Elpi derive.param1.functor is_I. Definition is_I_functor A PA PB (f : forall x, PA x -> PB x) a : I A PA a -> I A PB a. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "param1_functor.elpi" as param1_functor. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. Elpi Db derive.param1.functor.db lp:{{ pred param1-functor-db i:term, i:term, o:term. pred param1-functor-for i:inductive, o:gref, o:list bool. }}. Elpi Command derive.param1.functor. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File param1_functor. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.param1.functor.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.param1.functor.main GR "_functor" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.functor []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File param1_functor. Elpi Accumulate derive Db derive.param1.functor.db. Elpi Accumulate derive lp:{{ dep1 "param1_functor" "param1". derivation (indt T) _ (derive "param1_functor" (derive.on_param1 T derive.param1.functor.main "_functor") (derive.on_param1 T (T\_\_\param1-functor-for T _ _) _ _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/param1_trivial.v000066400000000000000000000157621451177652200237660ustar00rootroot00000000000000(* Given an inductive type I and its unary parametricity translation is_ it generates a proof of forall i : I, is_U i and then a proof of forall i : I, { p : is_I i & forall q, p = q }. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param1.elpi" as param1. From elpi.apps.derive Extra Dependency "param1_inhab.elpi" as param1_inhab. From elpi.apps.derive Extra Dependency "param1_trivial.elpi" as param1_trivial. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive.param1 derive.param1_congr. Definition is_uint63_inhab x : is_uint63 x. Proof. constructor. Defined. Register is_uint63_inhab as elpi.derive.is_uint63_inhab. Definition is_float64_inhab x : is_float64 x. Proof. constructor. Defined. Register is_float64_inhab as elpi.derive.is_float64_inhab. Definition is_eq_inhab A (PA : A -> Type) (HA : trivial A PA) (x : A) (px: PA x) y (py : PA y) (eq_xy : x = y) : is_eq A PA x px y py eq_xy. Proof. revert py. case eq_xy; clear eq_xy y. intro py. rewrite <- (trivial_uniq A PA HA x px); clear px. rewrite <- (trivial_uniq A PA HA x py); clear py. apply (is_eq_refl A PA x (trivial_full A PA HA x)). Defined. Register is_eq_inhab as elpi.derive.is_eq_inhab. Definition is_uint63_trivial : trivial PrimInt63.int is_uint63 := fun x => contracts _ is_uint63 x (is_uint63_inhab x) (fun y => match y with uint63 i => eq_refl end). Register is_uint63_trivial as elpi.derive.is_uint63_trivial. Definition is_float64_trivial : trivial PrimFloat.float is_float64 := fun x => contracts _ is_float64 x (is_float64_inhab x) (fun y => match y with float64 i => eq_refl end). Register is_float64_trivial as elpi.derive.is_float64_trivial. Lemma is_eq_trivial A (PA : A -> Type) (HA : trivial A PA) (x : A) (px: PA x) y (py : PA y) : trivial (x = y) (is_eq A PA x px y py). Proof. intro p. apply (contracts (x = y) (is_eq A PA x px y py) p (is_eq_inhab A PA HA x px y py p)). revert py. case p; clear p y. rewrite <- (trivial_uniq _ _ HA x px). clear px. intros py. rewrite <- (trivial_uniq _ _ HA x py). clear py. intro v; case v; clear v. unfold is_eq_inhab. unfold trivial_full. unfold trivial_uniq. case (HA x); intros it def_it; compute. case (def_it it). reflexivity. Defined. Register is_eq_trivial as elpi.derive.is_eq_trivial. Elpi Db derive.param1.trivial.db lp:{{ pred param1-trivial-done i:inductive. pred param1-inhab-done i:inductive. type param1-inhab-db term -> term -> prop. param1-inhab-db {{ lib:elpi.derive.is_uint63 }} {{ lib:elpi.derive.is_uint63_inhab }}. param1-inhab-db {{ lib:elpi.derive.is_float64 }} {{ lib:elpi.derive.is_float64_inhab }}. param1-inhab-db {{ lib:elpi.derive.is_eq }} {{ lib:elpi.derive.is_eq_inhab }}. param1-inhab-db (fun `f` (prod `_` S _\ T) f\ prod `x` S x\ prod `px` (RS x) _) (fun `f` (prod `_` S _\ T) f\ fun `x` S x\ fun `px` (RS x) _\ P f x) :- pi f x\ reali T R, param1-inhab-db R PT, coq.mk-app PT [{coq.mk-app f [x]}] (P f x). param1-inhab-db {{ lib:elpi.derive.is_eq lp:A lp:PA lp:X lp:PX lp:Y lp:PY }} {{ lib:elpi.derive.is_eq_inhab lp:A lp:PA lp:QA lp:X lp:PX lp:Y lp:PY }} :- !, param1-trivial-db PA QA. param1-inhab-db (app [Hd|Args]) (app[P|PArgs]) :- param1-inhab-db Hd P, !, param1-inhab-db-args Args PArgs. type param1-inhab-db-args list term -> list term -> prop. param1-inhab-db-args [] []. param1-inhab-db-args [T,P|Args] R :- std.assert-ok! (coq.typecheck T Ty) "param1-inhab-db: cannot work illtyped term", if (coq.sort? Ty) (param1-inhab-db P Q, R = [T,P,Q|PArgs], param1-inhab-db-args Args PArgs) (R = [T,P|PArgs], param1-inhab-db-args Args PArgs). type param1-trivial-db term -> term -> prop. param1-trivial-db {{ lib:elpi.derive.is_uint63 }} {{ lib:elpi.derive.is_uint63_trivial }}. param1-trivial-db {{ lib:elpi.derive.is_float64 }} {{ lib:elpi.derive.is_float64_trivial }}. param1-trivial-db (fun `f` (prod `_` S _\ T) f\ prod `x` S x\ prod `px` (RS x) _) (fun `f` (prod `_` S _\ T) f\ fun `x` S x\ fun `px` (RS x) _\ P f x) :- pi f x\ reali T R, param1-trivial-db R PT, coq.mk-app PT [{coq.mk-app f [x]}] (P f x). param1-trivial-db {{ lib:elpi.derive.is_eq lp:A lp:PA lp:X lp:PX lp:Y lp:PY }} {{ lib:elpi.derive.is_eq_trivial lp:A lp:PA lp:QA lp:X lp:PX lp:Y lp:PY }} :- param1-trivial-db PA QA. param1-trivial-db (app [Hd|Args]) (app[P|PArgs]) :- param1-trivial-db Hd P, !, param1-trivial-db-args Args PArgs. type param1-trivial-db-args list term -> list term -> prop. param1-trivial-db-args [] []. param1-trivial-db-args [T,P|Args] R :- std.assert-ok! (coq.typecheck T Ty) "param1-trivial-db: cannot work on illtyped term", if (coq.sort? Ty) (param1-trivial-db P Q, R = [T,P,Q|PArgs], param1-trivial-db-args Args PArgs) (R = [T,P|PArgs], param1-trivial-db-args Args PArgs). }}. (* standalone *) Elpi Command derive.param1.trivial. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate File param1_inhab. Elpi Accumulate File param1_trivial. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), derive.param1.inhab.main GR "_inhab" CL, CL => derive.param1.trivial.main GR "_trivial" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.trivial ". }}. Elpi Typecheck. Elpi Command derive.param1.inhab. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate File param1_inhab. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), derive.param1.inhab.main GR "_inhab" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.inhab ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.param1.trivial.db. Elpi Accumulate derive File param1_inhab. Elpi Accumulate derive File param1_trivial. Elpi Accumulate derive lp:{{ dep1 "param1_trivial" "param1_inhab". dep1 "param1_trivial" "param1_congr". dep1 "param1_inhab" "param1". derivation (indt T) _ (derive "param1_inhab" (derive.on_param1 T derive.param1.inhab.main "_inhab") (derive.on_param1 T (T\_\_\param1-inhab-done T) _ _)). derivation (indt T) _ (derive "param1_trivial" (derive.on_param1 T derive.param1.trivial.main "_trivial") (derive.on_param1 T (T\_\_\param1-trivial-done T) _ _)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/param2.v000066400000000000000000000036421451177652200222270ustar00rootroot00000000000000(* Binary parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive Extra Dependency "param2.elpi" as param2. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. (* To be removed *) Class param_db {X X1 XR : Type} (x : X) (x : X1) (xR : XR) := store_param {}. Class param {X : Type} {XR : X -> X -> Type} (x : X) (xR : XR x x) := Param {}. Register store_param as param2.store_param. (* Links a term (constant, inductive type, inductive constructor) with its parametricity translation *) Elpi Db derive.param2.db lp:{{ pred param-done i:gref. :index(3) pred param i:term, o:term, o:term. :name "param:fail" param X _ _ :- M is "derive.param2: No binary parametricity translation for " ^ {coq.term->string X}, stop M. type paramR term -> term -> term -> prop. :name "paramR:fail" paramR T T1 TR :- M is "derive.param2: No binary parametricity translation linking " ^ {coq.term->string T} ^ " and " ^ {coq.term->string T1} ^ " and " ^ {coq.term->string TR}, stop M. }}. Elpi Command derive.param2. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate File param2. Elpi Accumulate Db derive.param2.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, derive.param2.main GR "" _. main _ :- usage. usage :- coq.error "Usage: derive.param2 ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File param2. Elpi Accumulate derive Db derive.param2.db. Elpi Accumulate derive lp:{{ derivation T N (derive "param2" (derive.param2.main T N) (param-done T)). }}. coq-elpi-1.19.3/apps/derive/theories/derive/projK.v000066400000000000000000000027701451177652200221330ustar00rootroot00000000000000(* Generates a projection for each argument of each constructor. The projection is expected to be applied to an explicit construcor and all its arguments. It is used to implement "injection". license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Extra Dependency "projK.elpi" as projK. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. Elpi Db derive.projK.db lp:{{ type projK-db constructor -> int -> term -> prop. :name "projK-db:fail" projK-db GR N _ :- M is "derive.projK: can't find the projection " ^ {std.any->string N} ^ " for constructor " ^ {std.any->string GR}, stop M. }}. Elpi Command derive.projK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File projK. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.projK.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.projK.main GR "proj" _. main _ :- usage. usage :- coq.error "Usage: derive.projK []". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive File projK. Elpi Accumulate derive Db derive.projK.db. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix (derive "projK" (derive.projK.main T N) (derive.exists-indc T (K\ projK-db K _ _))) :- N is Prefix ^ "getk_". }}. coq-elpi-1.19.3/apps/derive/theories/derive/std.v000066400000000000000000000015351451177652200216360ustar00rootroot00000000000000(* Standard set of derivations license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps Require Export derive. From elpi.apps Require Export derive.map derive.lens derive.lens_laws derive.param1 derive.param1_congr derive.param1_trivial derive.param1_functor derive.param2 derive.induction derive.tag derive.fields derive.eqb derive.eqbcorrect derive.eqbOK . Elpi Typecheck derive. (* we derive the Coq prelude *) Module Prelude. derive Init.Datatypes.Empty_set. derive Init.Datatypes.unit. derive Init.Datatypes.bool. derive Init.Datatypes.nat. derive Init.Datatypes.option. derive Init.Datatypes.sum. derive Init.Datatypes.prod. derive Init.Datatypes.list. derive Init.Datatypes.comparison. End Prelude. Export Prelude. coq-elpi-1.19.3/apps/derive/theories/derive/tag.v000066400000000000000000000021451451177652200216150ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive. From Coq Require Import PArith. From elpi.apps.derive Extra Dependency "tag.elpi" as tag. From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. Register positive as elpi.derive.positive. Local Open Scope positive_scope. Elpi Db derive.tag.db lp:{{ % this is how one registers the tag function to an inductive and let other % elpi commands use that piece of info pred tag-for o:inductive, o:constant. }}. (* standalone *) Elpi Command derive.tag. Elpi Accumulate File derive_hook. Elpi Accumulate File tag. Elpi Accumulate Db derive.tag.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Prefix is Tname ^ "_", derive.tag.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.tag ". }}. Elpi Typecheck. (* hook into derive *) Elpi Accumulate derive Db derive.tag.db. Elpi Accumulate derive File tag. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix (derive "tag" (derive.tag.main T Prefix) (tag-for T _)). }}. coq-elpi-1.19.3/apps/eltac/000077500000000000000000000000001451177652200153635ustar00rootroot00000000000000coq-elpi-1.19.3/apps/eltac/Makefile000066400000000000000000000022501451177652200170220ustar00rootroot00000000000000# detection of coq ifeq "$(COQBIN)" "" COQBIN := $(shell which coqc >/dev/null 2>&1 && dirname `which coqc`) endif ifeq "$(COQBIN)" "" $(error Coq not found, make sure it is installed in your PATH or set COQBIN) else $(info Using coq found in $(COQBIN), from COQBIN or PATH) endif export COQBIN := $(COQBIN)/ all: build test build: Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq test: Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq theories/%.vo: force @$(MAKE) --no-print-directory -f Makefile.coq $@ tests/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ examples/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ Makefile.coq Makefile.coq.conf: _CoqProject @$(COQBIN)/coq_makefile -f _CoqProject -o Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq .merlin Makefile.test.coq Makefile.test.coq.conf: _CoqProject.test @$(COQBIN)/coq_makefile -f _CoqProject.test -o Makefile.test.coq clean: Makefile.coq Makefile.test.coq @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.19.3/apps/eltac/_CoqProject000066400000000000000000000007331451177652200175210ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps # Hack to see derive even if it is not installed yet -Q ../derive/theories elpi.apps -Q ../derive/elpi elpi.apps.derive -R theories elpi.apps.eltac theories/assumption.v theories/constructor.v theories/intro.v theories/clear.v theories/fail.v theories/discriminate.v theories/injection.v theories/case.v theories/generalize.v theories/cycle.v theories/tactics.v coq-elpi-1.19.3/apps/eltac/_CoqProject.test000066400000000000000000000010301451177652200204660ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps # Hack to see derive even if it is not installed yet -Q ../derive/theories elpi.apps -R theories elpi.apps.eltac -R tests elpi.apps.eltac.tests -R examples elpi.apps.eltac.examples tests/test_assumption.v tests/test_constructor.v tests/test_intro.v tests/test_clear.v tests/test_fail.v tests/test_discriminate.v tests/test_injection.v tests/test_case.v tests/test_generalize.v tests/test_cycle.v examples/usage_eltac.v coq-elpi-1.19.3/apps/eltac/examples/000077500000000000000000000000001451177652200172015ustar00rootroot00000000000000coq-elpi-1.19.3/apps/eltac/examples/usage_eltac.v000066400000000000000000000004701451177652200216450ustar00rootroot00000000000000From elpi.apps Require Import derive. From elpi.apps Require Import eltac.tactics. derive nat. Lemma example : forall x y : nat, S x = S y -> 0 = 1 -> False. Proof. eltac.intro "x". eltac.intro "y". eltac.intro "I". eltac.intro "D". eltac.injection I. eltac.intro "E". eltac.clear E. eltac.discriminate D. Qed.coq-elpi-1.19.3/apps/eltac/tests/000077500000000000000000000000001451177652200165255ustar00rootroot00000000000000coq-elpi-1.19.3/apps/eltac/tests/test_assumption.v000066400000000000000000000003041451177652200221520ustar00rootroot00000000000000From elpi.apps Require Import eltac.assumption. Lemma test1 x (H : x = 0) : x = 0. Proof. eltac.assumption. Qed. Example test_assumption : True -> True. Proof. intro x. eltac.assumption. Qed. coq-elpi-1.19.3/apps/eltac/tests/test_case.v000066400000000000000000000012661451177652200206730ustar00rootroot00000000000000From elpi.apps Require Import eltac.case. Lemma test1 (n : nat) : n = n. Proof. eltac.case n. exact (refl_equal 0). exact (refl_equal (S _)). Qed. Inductive is_even : nat -> Prop := | even0 : is_even 0 | evenS : forall x, is_even x -> is_even (S (S x)). Lemma test2 (n : nat) (H : is_even n) : n = n. Proof. eltac.case H. exact (refl_equal 0). exact (refl_equal (S (S _))). Qed. Axiom q : nat -> Prop. Axiom p0 : q 0. (* The last 0 must not be abstracted or the goal is illtyped *) Lemma test3 (H : is_even 0) : 0 = 0 /\ (@eq (q 0) p0 p0). Proof. eltac.case H. split. exact (refl_equal 0). exact (refl_equal p0). split; [ exact (refl_equal (S (S _))) | exact (refl_equal p0) ]. Qed. coq-elpi-1.19.3/apps/eltac/tests/test_clear.v000066400000000000000000000005221451177652200210400ustar00rootroot00000000000000From elpi.apps Require Import eltac.clear. Example test_generalize_dependent x y (H : x = y) (H1 : 0 <= x) (d := x + 1) (H2 : y = 1) (w := 3): x + d + y = 2. Proof. generalize dependent x. Fail eltac.clear x. eltac.clear H2. Fail match goal with Hyp : y = 1 |- _ => idtac end. intros. eltac.clearbody d w. Fail unfold d. Check d. Abort. coq-elpi-1.19.3/apps/eltac/tests/test_constructor.v000066400000000000000000000003741451177652200223440ustar00rootroot00000000000000From elpi.apps Require Import eltac.constructor. Lemma test1 : 1 = 1. Proof. eltac.constructor. Qed. Example test_constructor : Type -> True * Type. Proof. intro x. eltac.constructor. - eltac.constructor. - try eltac.constructor. assumption. Qed. coq-elpi-1.19.3/apps/eltac/tests/test_cycle.v000066400000000000000000000004771451177652200210620ustar00rootroot00000000000000From elpi.apps Require Import eltac.cycle. Goal True /\ False /\ 1=1. split;[|split]. all: eltac.cycle 1. admit. reflexivity. exact I. Abort. Goal True /\ False /\ 1=1. split;[|split]. all: eltac.cycle -1. reflexivity. exact I. admit. Abort. Goal True /\ False /\ 1=1. split;[|split]. Fail all: eltac.cycle 3. Abort.coq-elpi-1.19.3/apps/eltac/tests/test_discriminate.v000066400000000000000000000012301451177652200224220ustar00rootroot00000000000000From elpi.apps Require Import eltac.discriminate. Set Implicit Arguments. Inductive foo (A : Type) | (B : Type) : nat -> Type := | K : foo B 0 | K1 : forall n, foo B n -> foo B (S n) | K2 : forall n, (A -> foo (B*B) n) -> foo B (n+n). Elpi derive.isK foo. (* Let's test a little that we are not too syntactic *) Definition AliasK2 A B n (f : A -> foo A (B*B) n) := K2 f. Definition AliasEQ := @eq. Example test_discriminate (k : foo nat nat 0) (f : nat -> foo nat (nat*nat) 1) : AliasEQ (AliasK2 f) (K1 (K1 k)) -> K nat nat = K nat nat -> { Type = Prop } + { True = False }. Proof. intros H F. Fail eltac.discriminate (F). eltac.discriminate (H). Qed. coq-elpi-1.19.3/apps/eltac/tests/test_fail.v000066400000000000000000000001531451177652200206650ustar00rootroot00000000000000From elpi.apps Require Import eltac.fail. Goal False. try (eltac.fail 0). Fail try (eltac.fail 1). Abort. coq-elpi-1.19.3/apps/eltac/tests/test_generalize.v000066400000000000000000000003101451177652200220720ustar00rootroot00000000000000From elpi.apps Require Import eltac.generalize. Example test_generalize x y (H : x = y) (H1 : 0 <= x) (d := x + 1) (H2 : y = 1) : x + d + y = 2. Proof. eltac.generalize (x). intros x0 T0 T1. Abort. coq-elpi-1.19.3/apps/eltac/tests/test_injection.v000066400000000000000000000011111451177652200217270ustar00rootroot00000000000000From elpi.apps Require Import eltac.injection. Set Implicit Arguments. Elpi derive.projK nat. Lemma test_nat (a b :nat) : S a = S b -> a = b. Proof. intro H. eltac.injection (H). intro E. assumption. Qed. Require Vector. Require Import ssreflect Arith. Elpi derive.projK Vector.t. Lemma test_vect A a b n (v1 v2 : Vector.t A n) : Vector.cons A a n v1 = Vector.cons A b n v2 -> a = b /\ v1 = v2. Proof. intro H. eltac.injection (H). move=> /= Eab _ Esigv12. split. exact Eab. rewrite -[v2](projT2_eq Esigv12) /=. by rewrite (UIP_nat _ _ (projT1_eq Esigv12) (eq_refl n)). Qed.coq-elpi-1.19.3/apps/eltac/tests/test_intro.v000066400000000000000000000002631451177652200211070ustar00rootroot00000000000000From elpi.apps Require Import eltac.intro. Lemma test1 : forall x, x = 1. Proof. eltac.intro "a". Abort. Example test_intro : True -> True. Proof. eltac.intro x. exact x. Qed. coq-elpi-1.19.3/apps/eltac/theories/000077500000000000000000000000001451177652200172055ustar00rootroot00000000000000coq-elpi-1.19.3/apps/eltac/theories/assumption.v000066400000000000000000000005021451177652200215730ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic assumption. Elpi Accumulate lp:{{ solve (goal Ctx Ev _ _ _) [] :- std.exists Ctx (x\ x = decl Ev _ _ ; x = def Ev _ _ _). solve _ _ :- coq.ltac.fail _ "No assumption unifies with the goal". }}. Elpi Typecheck. Tactic Notation "eltac.assumption" := elpi assumption. coq-elpi-1.19.3/apps/eltac/theories/case.v000066400000000000000000000022331451177652200203070ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic case. Elpi Accumulate lp:{{ pred mk-abstracted-goal i:list term, i:term, i:term, i:list term, i:list term, o:term. mk-abstracted-goal ToAbstract Goal _IndSort Vars _VarsTys Out :- std.map2 ToAbstract Vars (t\v\r\ r = copy t v) Subst, % Non deterministically we abstract until we obtain a well typed term Subst => copy Goal Out, coq.say "trying" {coq.term->string Out}, coq.typecheck Out _ ok. pred mk-empty-branches i:term, i:term, i:list term, i:list term, o:term. mk-empty-branches _K _KTy _Vars _VarsTys HOLE_. solve (goal _ _ GTy _ [trm T] as G) NG :- !, std.do! [ std.assert-ok! (coq.typecheck T Ty) "input term illtyped", std.assert! (coq.safe-dest-app Ty (global (indt I)) Args) "the type is not inductive", coq.env.indt I _ ParamsNo _ _ _ _, std.drop ParamsNo Args Idxs, std.append Idxs [T] ToAbstract, coq.build-match T Ty (mk-abstracted-goal ToAbstract GTy) mk-empty-branches M, refine M G NG ]. solve _ _ :- usage. usage :- coq.error "Usage: eltac.case ". }}. Elpi Typecheck. Tactic Notation "eltac.case" constr(T) := elpi case ltac_term:(T). coq-elpi-1.19.3/apps/eltac/theories/clear.v000066400000000000000000000036101451177652200204620ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic clear. Elpi Accumulate lp:{{ pred not-hyp i:term, i:prop, o:term. not-hyp X (decl Y _ Ty) Y :- not (occurs X Ty), not (X = Y). not-hyp X (def Y _ Ty Bo) Y :- not (occurs X Ty ; occurs X Bo), not (X = Y). solve (goal Ctx R T E [trm X]) [seal (goal Ctx R T E [])] :- name X, !, std.do! [ std.map-filter Ctx (not-hyp X) VisibleRev, prune E1 {std.rev VisibleRev}, % preserve the order std.assert-ok! (coq.typecheck E1 T) "cannot clear", E = E1 ]. solve (goal _ _ _ _ Args) _ :- coq.error "clear expects 1 name, you passed:" Args. }}. Elpi Typecheck. Tactic Notation "eltac.clear" hyp(V) := elpi clear ltac_term:(V). Elpi Tactic clearbody. Elpi Accumulate lp:{{ pred drop-body i:list argument, i:prop, o:prop. drop-body ToBeCleared (def V Name Ty _Bo) (decl V Name Ty) :- std.mem ToBeCleared (trm V), !. drop-body _ (decl _ _ _ as X) X. drop-body _ (def _ _ _ _ as X) X. msolve [nabla G] [nabla G1] :- pi x\ msolve [G x] [G1 x]. msolve [seal (goal Ctx _ T E ToBeCleared)] [seal (goal Ctx1 _ T E1 [])] :- std.map Ctx (drop-body ToBeCleared) Ctx1, @ltacfail! 0 => % this failure can be catch by ltac Ctx1 => % in the new context, do... std.assert-ok! (coq.typecheck-ty T _) "cannot clear since the goal does not typecheck in the new context", Ctx1 => std.assert-ok! (coq.typecheck E1 T) "should not happen", % E1 see all the proof variables (the pi x in the nabla case) and T is OK in Ctx1 E = {{ lp:E1 : lp:T }}. % we make progress by saying that the old goal/evar is solved by the new one (which has the same type thanks to the line above) % note that E = E1 would be "unstable" since elpi could decide to % actually do E1 := E, while E = (let `x` T E1 x\x) forces elpi % to go the other way around }}. Elpi Typecheck. Tactic Notation "eltac.clearbody" hyp_list(V) := elpi clearbody ltac_term_list:(V). coq-elpi-1.19.3/apps/eltac/theories/constructor.v000066400000000000000000000010171451177652200217600ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic constructor. Elpi Accumulate lp:{{ solve (goal _ _ Ty _ _ as G) GS :- std.do! [ @ltacfail! _ => std.assert! (whd Ty [] (global (indt GR)) _) "The goal is not an inductive type", coq.env.indt GR _ _ _ _ Ks Kt, std.exists2 Ks Kt (k\ t\ sigma P\ coq.saturate t (global (indc k)) P, refine P G GS) ]. solve _ _ :- coq.error "eltac.constructor: this should never happen". }}. Elpi Typecheck. Tactic Notation "eltac.constructor" := elpi constructor. coq-elpi-1.19.3/apps/eltac/theories/cycle.v000066400000000000000000000012471451177652200204770ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic cycle. Elpi Accumulate lp:{{ pred read-arg i:sealed-goal, o:list argument. read-arg (nabla G) X :- pi x\ read-arg (G x) X. read-arg (seal (goal _ _ _ _ A)) A. pred cycle i:int, i:list sealed-goal, o:list sealed-goal. cycle N L PL :- N > 0, std.length L M, std.assert! (N < M) "not enough goals", std.split-at N L B A, std.append A B PL. cycle N L PL :- N < 0, std.length L M, N' is M + N, cycle N' L PL. msolve GL GS :- GL = [G|_], read-arg G [int N], if (N = 0) (GS = GL) (cycle N GL GS). }}. Elpi Typecheck. Tactic Notation "eltac.cycle" int(n) := elpi cycle ltac_int:(n). coq-elpi-1.19.3/apps/eltac/theories/discriminate.v000066400000000000000000000011421451177652200220450ustar00rootroot00000000000000From elpi.apps.derive Extra Dependency "discriminate.elpi" as discriminate. From elpi.apps Require Export derive.isK derive.bcongr derive.eqK. (** A tactic proving the current goal out of a false equation *) Elpi Tactic discriminate. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File discriminate. Elpi Accumulate lp:{{ solve (goal _ Ev Ty _ [trm E] ) [] :- !, of E Eq ER, !, ltac.discriminate ER Eq Ty Ev. solve _ _ :- usage. usage :- coq.error "Usage: eltac.discriminate ". }}. Elpi Typecheck. Tactic Notation "eltac.discriminate" constr(T) := elpi discriminate ltac_term:(T). coq-elpi-1.19.3/apps/eltac/theories/fail.v000066400000000000000000000004571451177652200203150ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic fail. Elpi Accumulate lp:{{ solve (goal _ _ _ _ [int N]) _ :- coq.ltac.fail N. solve (goal _ _ _ _ Args) _ :- coq.error "eltac.fail expects 1 integer, you passed:" Args. }}. Elpi Typecheck. Tactic Notation "eltac.fail" int(n) := elpi fail ltac_int:(n). coq-elpi-1.19.3/apps/eltac/theories/generalize.v000066400000000000000000000011141451177652200215160ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic generalize. Elpi Accumulate lp:{{ pred occurs-hyp i:term, i:prop, o:term. occurs-hyp X (decl Y _ Ty) Y :- occurs X Ty. occurs-hyp X (def Y _ Ty Bo) Y :- occurs X Ty ; occurs X Bo. solve (goal Ctx _ _ _ [trm X] as G) GS :- name X, !, std.do! [ std.map-filter Ctx (occurs-hyp X) Generalize, refine (app[NEW_,X|Generalize]) G GS, ]. solve (goal _ _ _ _ Args) _ :- coq.error "eltac.generalize expects 1 name, you passed:" Args. }}. Elpi Typecheck. Tactic Notation "eltac.generalize" constr(V) := elpi generalize ltac_term:(V). coq-elpi-1.19.3/apps/eltac/theories/injection.v000066400000000000000000000012341451177652200213560ustar00rootroot00000000000000From elpi.apps.derive Extra Dependency "injection.elpi" as injection. From elpi.apps Require Export derive.projK derive.bcongr. (** A tactic pushing an equation under a constructor *) Elpi Tactic injection. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File injection. Elpi Accumulate lp:{{ solve (goal _ _ _ _ [trm E] as G) NG :- !, of E Eq ER, !, ltac.injection ER Eq _ P, if (P = []) (coq.error "Could not generate new equations") (refine (app[New_|P]) G NG). solve _ _ :- usage. usage :- coq.error "Usage: eltac.injection ". }}. Elpi Typecheck. Tactic Notation "eltac.injection" constr(T) := elpi injection ltac_term:(T).coq-elpi-1.19.3/apps/eltac/theories/intro.v000066400000000000000000000007301451177652200205270ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic intro. Elpi Accumulate lp:{{ solve (goal _ _ _ _ [str ID] as G) GS :- !, std.assert! (coq.ltac.id-free? ID G) "name already taken", coq.id->name ID N, refine (fun N _ _) G GS. solve _ _ :- usage. usage :- coq.error "Usage: eltac.intro". }}. Elpi Typecheck. Tactic Notation "eltac.intro" string(ID) := elpi intro ltac_string:(ID). Tactic Notation "eltac.intro" ident(ID) := elpi intro ltac_string:(ID). coq-elpi-1.19.3/apps/eltac/theories/tactics.v000066400000000000000000000002161451177652200210250ustar00rootroot00000000000000From elpi.apps.eltac Require Export intro constructor assumption discriminate injection case generalize fail clear cycle .coq-elpi-1.19.3/apps/locker/000077500000000000000000000000001451177652200155525ustar00rootroot00000000000000coq-elpi-1.19.3/apps/locker/Makefile000066400000000000000000000022501451177652200172110ustar00rootroot00000000000000# detection of coq ifeq "$(COQBIN)" "" COQBIN := $(shell which coqc >/dev/null 2>&1 && dirname `which coqc`) endif ifeq "$(COQBIN)" "" $(error Coq not found, make sure it is installed in your PATH or set COQBIN) else $(info Using coq found in $(COQBIN), from COQBIN or PATH) endif export COQBIN := $(COQBIN)/ all: build test build: Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq test: Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq theories/%.vo: force @$(MAKE) --no-print-directory -f Makefile.coq $@ tests/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ examples/%.vo: force build Makefile.test.coq @$(MAKE) --no-print-directory -f Makefile.test.coq $@ Makefile.coq Makefile.coq.conf: _CoqProject @$(COQBIN)/coq_makefile -f _CoqProject -o Makefile.coq @$(MAKE) --no-print-directory -f Makefile.coq .merlin Makefile.test.coq Makefile.test.coq.conf: _CoqProject.test @$(COQBIN)/coq_makefile -f _CoqProject.test -o Makefile.test.coq clean: Makefile.coq Makefile.test.coq @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.19.3/apps/locker/README.md000066400000000000000000000027751451177652200170440ustar00rootroot00000000000000# Locker The `lock` and `mlock` commands let you lock definitions. ## Example of `lock` ```coq lock Definition x := 3. ``` is elaborated to ```coq Lemma x_key_subproof : unit. Proof. exact: tt. Qed. Definition x := locked_with x_key_subproof 3. Canonical x_unlock_subterm := Unlockable ... ``` Here `locked_with` comes from `ssreflect.v` and protects the body of `x` under a match on `x_key_subproof` which is `Qed` opaque. Hence `x` is provably equal to 3, but not computationally equal to it. Given the canonical structure registration, `rewrite unlock` will replace `x` by `3`. ## Example of `mlock` ```coq mlock Definition x := 3. ``` is elaborated to ```coq Module Type x_Locked. Axiom body : nat. Axiom unlock : body = 3. End x_Locked. Module x : x_Locked. ... End x. Notation x := x.body. Canonical x_unlock_subterm := Unlockable x.unlock. ``` Hence `x` (actually `x.body`) is a new symbol and `x.unlock` is its defining equation. Given the canonical structure registration, `rewrite unlock` will replace `x` by `3`. ## Limitations `mlock` uses a module based locking. The body is really sealed but this command cannot be used inside sections (since modules cannot be declared inside sections). `lock` uses opaque key based locking. It can be used everywhere, even inside sections, but conversion (term comparison) may cross the lock (by congruence) and hence compare possibly large terms. See also the section about locking in [ssereflect.v](https://github.com/coq/coq/blob/master/theories/ssr/ssreflect.v). coq-elpi-1.19.3/apps/locker/_CoqProject000066400000000000000000000002611451177652200177040ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps -R theories elpi.apps -Q elpi elpi.apps.locker theories/locker.v coq-elpi-1.19.3/apps/locker/_CoqProject.test000066400000000000000000000002751451177652200206670ustar00rootroot00000000000000# Hack to see Coq-Elpi even if it is not installed yet -Q ../../theories elpi -I ../../src -docroot elpi.apps -R theories elpi.apps -R tests elpi.apps.locker.tests tests/test_locker.v coq-elpi-1.19.3/apps/locker/elpi/000077500000000000000000000000001451177652200165035ustar00rootroot00000000000000coq-elpi-1.19.3/apps/locker/elpi/locker.elpi000066400000000000000000000113661451177652200206440ustar00rootroot00000000000000/* Locker */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace locker { pred key-lock i:id, i:term, i:arity, i:option upoly-decl. key-lock ID Bo Arity UnivDecl :- std.do! [ make-key ID Key, coq.arity->term Arity Ty, Def = {{ @locked_with lp:Key lp:Ty lp:Bo }}, std.assert-ok! (coq.typecheck Def _) "locker: illtyped definition", if (UnivDecl = some UD) (coq.upoly-decl->attribute UD Poly!) (Poly! = true), Poly! => coq.env.add-const ID Def Ty @transparent! C, coq.arity->implicits Arity CImpls, if (coq.any-implicit? CImpls) (@global! => coq.arguments.set-implicit (const C) [CImpls]) true, make-key-unlockable ID Def Ty {coq.env.global (const C)} Key, ]. pred make-key i:id, o:term. make-key ID (global (const C)) :- std.do! [ if (get-option "key" KID) true (KID is ID ^ "_key_subproof"), coq.env.add-const KID {{ tt }} {{ unit }} @opaque! C, ]. % ------------------------------------------------------------------------- pred module-lock i:id, i:term, i:arity, i:option upoly-decl. module-lock ID Bo Arity UnivDecl :- std.do! [ coq.arity->term Arity Ty, std.assert-ok! (coq.typecheck-ty Ty _) "locker: definition type illtyped", std.assert-ok! (coq.typecheck Bo Ty) "locker: definition body illtyped", % we craft all constants now since we need to put *in the interface* the % extra universe constraints (if upoly) which are necessary for the body! if (UnivDecl = some UD) (std.do![ PTY = {{ lp:Bo = lp:Bo }}, std.assert-ok! (coq.typecheck-ty PTY _) "lock: unlock statement illtyped", P = {{ @refl_equal lp:Ty lp:Bo }}, std.assert-ok! (coq.typecheck P PTY) "locker: unlock proof illtyped", coq.upoly-decl.complete-constraints UD UD1, UnivDecl1 = some UD1]) (UnivDecl1 = none), lock-module-type ID Ty Bo UnivDecl1 Signature, lock-module-body Signature ID Ty Bo UnivDecl1 Symbol Module, @global! => coq.notation.add-abbreviation ID 0 Symbol ff _, coq.arity->implicits Arity CImpls, if (coq.any-implicit? CImpls) (Symbol = global GR, @global! => coq.arguments.set-implicit GR [CImpls]) true, make-module-unlockable ID Module, ]. pred lock-module-type i:id, i:term, i:term, i:option upoly-decl, o:modtypath. lock-module-type ID Ty Bo UnivDecl M :- std.do! [ Module is ID ^ "_Locked", coq.env.begin-module-type Module, if (UnivDecl = some UD) (coq.upoly-decl->attribute UD Poly!) (Poly! = true), Poly! => coq.env.add-axiom "body" Ty C, coq.env.global (const C) B, PTY = {{ lp:B = lp:Bo }}, std.assert-ok! (coq.typecheck-ty PTY _) "lock: unlock statement illtyped", if (UnivDecl = some UD) (coq.upoly-decl.complete-constraints UD UD1, coq.upoly-decl->attribute UD1 Poly1!) (Poly1! = true), Poly1! => coq.env.add-axiom "unlock" PTY _, coq.env.end-module-type M, ]. pred lock-module-body o:modtypath, i:id, i:term, i:term, i:option upoly-decl, o:term, o:modpath. lock-module-body Signature ID Ty Bo UnivDecl B M :- std.do! [ coq.env.begin-module ID (some Signature), if (UnivDecl = some UD) (coq.upoly-decl->attribute UD Poly!) (Poly! = true), Poly! => coq.env.add-const "body" Bo Ty @transparent! C, coq.env.global (const C) B, P = {{ @refl_equal lp:Ty lp:B }}, std.assert-ok! (coq.typecheck P _) "locker: unlock proof illtyped", PTY = {{ lp:B = lp:Bo }}, std.assert-ok! (coq.typecheck-ty PTY _) "locker: unlock statement illtyped", if (UnivDecl = some UD) (coq.upoly-decl.complete-constraints UD UD1, coq.upoly-decl->attribute UD1 Poly1!) (Poly1! = true), Poly1! => coq.env.add-const "unlock" P PTY @opaque! _, coq.env.end-module M, ]. % ------------------------------------------------------------------------- % Unlocking via the ssreflect Unlockable interface (CS instance) pred make-key-unlockable i:string, i:term, i:term, i:term, i:term. make-key-unlockable ID DefBo Ty LockedDef Key :- std.do! [ % we extract the real body in order to be precise in the unlocking equation DefBo = {{ @locked_with _ _ lp:Bo }}, UnlockEQ = {{ @locked_withE lp:Ty lp:Key lp:Bo }}, Unlock = {{ @Unlockable _ _ lp:LockedDef lp:UnlockEQ }}, make-unlockable ID Unlock, ]. pred make-module-unlockable i:id, i:modpath. make-module-unlockable ID Module :- std.do! [ coq.env.module Module [_,gref UnlockEQ], coq.env.global UnlockEQ UnlockEQT, Unlock = {{ Unlockable lp:UnlockEQT }}, make-unlockable ID Unlock, ]. pred make-unlockable i:id, i:term. make-unlockable ID Unlock :- std.do! [ std.assert-ok! (coq.typecheck Unlock UnlockTy) "locker: unlocking instance illtyped", UID is ID ^ "_unlock_subterm", coq.env.add-const UID Unlock UnlockTy _ U, coq.CS.declare-instance (const U), ]. } coq-elpi-1.19.3/apps/locker/tests/000077500000000000000000000000001451177652200167145ustar00rootroot00000000000000coq-elpi-1.19.3/apps/locker/tests/test_locker.v000066400000000000000000000062011451177652200214200ustar00rootroot00000000000000From Coq Require Import ssreflect. From elpi.apps Require Import locker. (* ----------------------- *) lock Definition d1 := 3. Lemma test_1_0 : d1 = 3. Proof. rewrite unlock. match goal with |- 3 = 3 => by [] end. Qed. Lemma test_1_1 : d1 = 3. Proof. unfold d1. match goal with |- locked_with d1_key_subproof 3 = 3 => by rewrite unlock end. Qed. (* ----------------------- *) Fail lock Axiom d2 : nat. (* ----------------------- *) Section S1. Variable T : Type. #[key="foo"] lock Definition d2 (x : T) := x. End S1. Lemma test_2_0 : d2 nat 3 = 3. Proof. unfold d2. match goal with |- locked_with foo (fun x => x) 3 = 3 => by rewrite unlock end. Qed. (* ----------------------- *) mlock Definition d3 := 3. Print Module d3. Print Module Type d3_Locked. Lemma test_3_0 : d3 = 3. Proof. rewrite unlock. match goal with |- 3 = 3 => by [] end. Qed. Lemma test_3_1 : d3 = 3. Proof. Fail unfold d3. rewrite d3.unlock. by []. Qed. (* ----------------------- *) Section S2. Fail mlock Definition d4 := 3. End S2. (* #286 ----------------------- *) Module Bug_286. Module Import lock_container. Unset Implicit Arguments. lock Definition cons2 {A} x xs := @cons A x xs. End lock_container. About cons2. Definition foo := cons2 0 nil. Class EqDecision (A : Type) := { f : A -> A -> bool }. #[local] Instance xx : EqDecision nat := {| f := (fun _ _ => true) |}. Module Import lock_container2. lock Definition cons3 [A] `{EqDecision A} x xs := @cons A x xs. End lock_container2. Definition foo3 := cons3 0 nil. About cons3. End Bug_286. Module test_286_global_implicits. Unset Implicit Arguments. Module mlock_container. mlock Definition def {A} (a : A) := a. End mlock_container. Fail Definition user1 {A} (a : A) := mlock_container.def _ a. Definition user1 {A} (a : A) := mlock_container.def a. Import mlock_container. Fail Definition user2 {A} (a : A) := def _ a. Definition user2 {A} (a : A) := def a. End test_286_global_implicits. (* https://coq.zulipchat.com/#narrow/stream/253928-Elpi-users-.26-devs/topic/Reifying.20terms.20with.20ltac.20.2F.20if-then-else.20.2F.20complex.20match *) Module elab. mlock Definition y (z : nat) := ltac:(exact z). mlock Definition q (b : bool) := if b then 1 else 0. End elab. (* ----------------------- *) Elpi Command test. (* for queries *) Set Printing Universes. lock #[universes(polymorphic)] Definition id1@{u} (T : Type@{u}) (x : T) := x. About id1. Elpi Query lp:{{ coq.locate "id1" GR, coq.env.univpoly? GR 1 }}. mlock #[universes(polymorphic)] Definition id2@{u} (T : Type@{u}) (x : T) := x. About id2.body. Elpi Query lp:{{ coq.locate "id2" GR, coq.env.univpoly? GR 1 }}. Set Universe Polymorphism. mlock Definition up1 (T : Type) (x : T) := x. About up1.body. Elpi Query lp:{{ coq.locate "up1" GR, coq.env.univpoly? GR 1 }}. mlock #[universes(polymorphic=no)] Definition nup1 (T : Type) (x : T) := x. About nup1.body. Elpi Query lp:{{ coq.locate "nup1" GR, not(coq.env.univpoly? GR _) }}. mlock Definition up2@{u +} (T : Type@{u}) (W : Type) (x : T) := x. About up2.body. Elpi Query lp:{{ coq.locate "up2" GR, coq.env.univpoly? GR 2 }}. Fail mlock Definition up3@{u} (T : Type@{u}) (W : Type) (x : T) := x. coq-elpi-1.19.3/apps/locker/theories/000077500000000000000000000000001451177652200173745ustar00rootroot00000000000000coq-elpi-1.19.3/apps/locker/theories/locker.v000066400000000000000000000041501451177652200210420ustar00rootroot00000000000000(* Locking mechanisms. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.locker Extra Dependency "locker.elpi" as locker. From Coq Require Import ssreflect. From elpi Require Import elpi. (** [lock] locks a definition on an opaque key + can be used everywhere - conversion may cross the lock (by congruence), while reduction will not Example: [[ lock Definition foo : T := bo. ]] Synthesizes: - [foo_key_subproof] an opaque term of type unit - [foo] unfolds to [locked_with foo_key_subproof bo] - [Canonical foo_unlock_subterm := Unlockable ...] so that [rewrite unlock] exposes the real body Supported attributes: - [#[key]] lets one override the name of the key *) Elpi Command lock. Elpi Accumulate File locker. Elpi Accumulate lp:{{ main [const-decl ID (some Bo) Ty] :- !, attributes A, coq.parse-attributes A [ att "key" string, ] Opts, !, Opts => locker.key-lock ID Bo Ty none. main [upoly-const-decl ID (some Bo) Ty UnivDecl] :- !, attributes A, coq.parse-attributes A [ att "key" string, ] Opts, !, Opts => locker.key-lock ID Bo Ty (some UnivDecl). main _ :- coq.error "Usage: lock Definition ...". }}. Elpi Typecheck. Elpi Export lock. (** [mlock] locks a definition behind a module type + hard locking (the body is really sealed) - cannot be used inside sections Example: [[ mlock Definition foo : T := bo. ]] Synthesizes: - [Module Type foo_Locked] with fields [body] and [unlock] where [body : T] and [unlock : body = bo] - [Module foo : foo_Locked] - [foo] a notation for [foo.body] - [Canonical foo_unlock_subterm := Unlockable ...] so that [rewrite unlock] exposes the real body *) Elpi Command mlock. Elpi Accumulate File locker. Elpi Accumulate lp:{{ main [const-decl ID (some Bo) Ty] :- !, locker.module-lock ID Bo Ty none. main [upoly-const-decl ID (some Bo) Ty UD] :- !, locker.module-lock ID Bo Ty (some UD). main _ :- coq.error "Usage: mlock Definition ...". }}. Elpi Typecheck. Elpi Export mlock. coq-elpi-1.19.3/coq-builtin.elpi000066400000000000000000002344371451177652200164460ustar00rootroot00000000000000 % Coq terms as the object language of elpi and basic API to access Coq % license: GNU Lesser General Public License Version 2.1 or later % ------------------------------------------------------------------------- % This file is automatically generated from % - coq-HOAS.elpi % - coq_elpi_builtin.ml % and contains the description of the data type of Coq terms and the % API to access Coq. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% coq-HOAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the low level data types linking Coq and elpi. % In particular: % - the data type for terms and the evar_map entries (a sequent) % - the entry points for commands and tactics (main and solve) % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry points % % Command and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry point for commands. Eg. "#[att=true] Elpi mycommand foo 3 (f x)." becomes % main [str "foo", int 3, trm (app[f,x])] % in a context where % attributes [attribute "att" (leaf "true")] % holds. The encoding of terms is described below. % See also the coq.parse-attributes utility. pred main i:list argument. pred usage. pred attributes o:list attribute. % Entry point for tactics. Eg. "elpi mytactic foo 3 (f x)." becomes % solve % Where [str "foo", int 3, trm (app[f,x])] is part of . % The encoding of goals is described below. % msolve is for tactics that operate on multiple goals (called via all: ). pred solve i:goal, o:list sealed-goal. pred msolve i:list sealed-goal, o:list sealed-goal. % The data type of arguments (for commands or tactics) kind argument type. type int int -> argument. % Eg. 1 -2. type str string -> argument. % Eg. x "y" z.w. or any Coq keyword/symbol type trm term -> argument. % Eg. (t). % Extra arguments for tactics type tac ltac1-tactic -> argument. % Extra arguments for commands. [Definition], [Axiom], [Record] and [Context] % take precedence over the [str] argument above (when not "quoted"). % % Eg. Record or Inductive type indt-decl indt-decl -> argument. % Eg. #[universes(polymorphic,...)] Record or Inductive type upoly-indt-decl indt-decl -> upoly-decl -> argument. type upoly-indt-decl indt-decl -> upoly-decl-cumul -> argument. % Eg. Definition or Axiom (when the body is none) type const-decl id -> option term -> arity -> argument. % Eg. #[universes(polymorphic,...)] Definition or Axiom type upoly-const-decl id -> option term -> arity -> upoly-decl -> argument. % Eg. Context A (b : A). type ctx-decl context-decl -> argument. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's terms % % Types of term formers % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- terms -------------------------------------------------------------------- kind term type. type sort sort -> term. % Prop, Type@{i} % constants: inductive types, inductive constructors, definitions type global gref -> term. type pglobal gref -> univ-instance -> term. % binders: to form functions, arities and local definitions type fun name -> term -> (term -> term) -> term. % fun x : t => type prod name -> term -> (term -> term) -> term. % forall x : t, type let name -> term -> term -> (term -> term) -> term. % let x : T := v in % other term formers: function application, pattern matching and recursion type app list term -> term. % app [hd|args] type match term -> term -> list term -> term. % match t p [branch]) type fix name -> int -> term -> (term -> term) -> term. % fix name rno ty bo type primitive primitive-value -> term. % NYI %type cofix name -> term -> (term -> term) -> term. % cofix name ty bo % Notes about (match Scrutinee TypingFunction Branches) when % Inductive i A : A -> nat -> Type := K : forall a : A, i A a 0 % and % Scrutinee be a term of type (i bool true 7) % % - TypingFunction has a very rigid shape that depends on i. Namely % as many lambdas as indexes plus one lambda for the inductive itself % where the value of the parameters are taken from the type of the scrutinee: % fun `a` (indt "bool") a\ % fun `n` (indt "nat) n\ % fun `i` (app[indt "i", indt "bool", a n) i\ .. % Such spine of fun cannot be omitted; else elpi cannot read the term back. % See also coq.bind-ind-arity-no-let in coq-lib.elpi, that builds such spine for you, % or the higher level api coq.build-match (same file) that also takes % care of breanches. % - Branches is a list of terms, the order is the canonical one (the order % of the constructors as they were declared). If the constructor has arguments % (excluding the parameters) then the corresponding term shall be a Coq % function. In this case % fun `x` (indt "bool") x\ .. % -- helpers ------------------------------------------------------------------ macro @cast T TY :- (let `cast` TY T x\x). % -- misc --------------------------------------------------------------------- % When one writes Constraint Handling Rules unification variables are "frozen", % i.e. represented by a fresh constant (the evar key) and a list of terms % (typically the variables in scope). kind evarkey type. type uvar evarkey -> list term -> term. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's evar_map % % Context and evar declaration % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % An evar_info (displayed as a Coq goal) is essentially a sequent: % % x : t % y := v : x % ---------- % p x y % % is coded as an Elpi query % % pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) % % where, by default, declare-evar creates a syntactic constraint as % % {x1 x2} : % decl x1 `x` , def x2 `y` x1 ?- % evar (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) /* suspended on RawEvar, Ev */ % % When the program is over, a remaining syntactic constraint like the one above % is read back and transformed into the corresponding evar_info. pred decl i:term, o:name, o:term. % Var Name Ty pred def i:term, o:name, o:term, o:term. % Var Name Ty Bo pred declare-evar i:list prop, i:term, i:term, i:term. % Ctx RawEvar Ty Evar :name "default-declare-evar" declare-evar Ctx RawEv Ty Ev :- declare_constraint (declare-evar Ctx RawEv Ty Ev) [RawEv]. % When a goal (evar _ _ _) is turned into a constraint the context is filtered % to only contain decl, def, pp. For now no handling rules for this set of % constraints other than one to remove a constraint pred rm-evar i:term, i:term. rm-evar (uvar as X) (uvar as Y):- !, declare_constraint (rm-evar X Y) [X,Y]. rm-evar _ _. constraint declare-evar evar def decl cache rm-evar { % Override the actual context rule \ (declare-evar Ctx RawEv Ty Ev) <=> (Ctx => evar RawEv Ty Ev). rule \ (rm-evar (uvar X _) (uvar Y _)) (evar (uvar X _) _ (uvar Y _)). rule \ (rm-evar (uvar X _) (uvar Y _)). } % The (evar R Ty E) predicate suspends when R and E are flexible, % and is solved otherwise. % The client may want to provide an alternative implementation of % the clause "default-assign-evar", for example to typechecks that the % term assigned to E has type Ty, or that the term assigned to R % elaborates to a term of type Ty that gets assigned to E. % In tactic mode, elpi/coq-elaborator.elpi wires things up that way. pred evar i:term, i:term, o:term. % Evar Ty RefinedSolution evar (uvar as X) T S :- var S _ VL, !, prune T VL, prune X VL, declare_constraint (evar X T S) [X, S]. :name "default-assign-evar" evar _ _ _. % volatile, only unresolved evars are considered as evars % To ease the creation of a context with decl and def % Eg. @pi-decl `x` x1\ @pi-def `y` y\ ... macro @pi-decl N T F :- pi x\ decl x N T => F x. macro @pi-def N T B F :- pi x\ def x N T B => cache x B_ => F x. macro @pi-parameter ID T F :- sigma N\ (coq.id->name ID N, pi x\ decl x N T => F x). macro @pi-inductive ID A F :- sigma N\ (coq.id->name ID N, coq.arity->term A T, pi x\ decl x N T => F x). % Sometimes it can be useful to pass to Coq a term with unification variables % representing "untyped holes" like an implicit argument _. In particular % a unification variable may exit the so called pattern fragment (applied % to distinct variables) and hence cannot be reliably mapped to Coq as an evar, % but can still be considered as an implicit argument. % By loading in the context get-option "HOAS:holes" tt one forces that % behavior. Here a convenience macro to be put on the LHS of => macro @holes! :- get-option "HOAS:holes" tt. % Similarly, some APIs take a term skeleton in input. In that case unification % variables are totally disregarded (not even mapped to Coq evars). They are % interpreted as the {{ lib:elpi.hole }} constant, which represents an implicit % argument. As a consenque these APIs don't modify the input term at all, but % rather return a copy. Note that if {{ lib:elpi.hole }} is used directly, then % it has to be applied to all variables in scope, since Coq erases variables % that are not used. For example using {{ forall x : nat, lib:elpi.hole }} as % a term skeleton is equivalent to {{ nat -> lib:elpi.hole }}, while % {{ forall x : nat, lib:elpi.hole x lib:elpi.hole more args }} puts x in % the scope of the hole (and passes to is more args). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's goals and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A Coq goal is essentially a sequent, like the evar_info above, but since it % has to be manipulated as first class Elpi data, it is represented in a slightly % different way. For example % % x : t % y := v : x % ---------- % g x y % % is represented by the following term of type sealed-goal % % nabla x1\ % nabla x2\ % seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % (Arguments x1 x2)) kind goal type. kind sealed-goal type. type nabla (term -> sealed-goal) -> sealed-goal. type seal goal -> sealed-goal. typeabbrev goal-ctx (list prop). type goal goal-ctx -> term -> term -> term -> list argument -> goal. % A sealed-goal closes with nabla the bound names of a % % (goal Ctx RawSolution Ty Solution Arguments) % % where Ctx is a list of decl or def and Solution is a unification variable % to be assigned to a term of type Ty in order to make progress. % RawSolution is used as a trigger: when a term is assigned to it, it is % elaborated against Ty and the resulting term is assigned to Solution. % % Arguments contains data attached to the goal, which lives in its context % and can be used by tactics to solve the goals. % A tactic (an elpi predicate which makes progress on a Coq goal) is % a predicate of type % sealed-goal -> list sealed-goal -> prop % % while the main entry point for a tactic written in Elpi is solve % which has type % goal -> list sealed-goal -> prop % % The utility (coq.ltac.open T G GL) postulates all the variables bounds % by nabla and loads the goal context before calling T on the unsealed % goal. The invocation of a tactic with arguments % 3 x "y" (h x) % on the previous goal results in the following Elpi query: % % (pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2)), % (coq.ltac.open solve % (nabla x1\ nabla x2\ seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % [int 3, str `x`, str`y`, trm (app[const `h`,x1])])) % NewGoals) % % If the goal sequent contains other evars, then a tactic invocation is % an Elpi query made of the conjunction of all the declare-evar queries % corresponding to these evars and the query corresponding to the goal % sequent. NewGoals can be assigned to a list of goals that should be % declared as open. Omitted goals are shelved. If NewGoals is not % assigned, then all unresolved evars become new goals, but the order % of such goals is not specified. % The file elpi-ltac.elpi provides a few combinators (other than coq.ltac.open) % in the tradition of LCF tacticals. The main difference is that the arguments % of custom written tactics must not be passed as predicate arguments but rather % put in the goal they receive. Indeed these arguments can contain terms, and % their bound variables cannot escape the seal. coq.ltac.set-goal-arguments % can be used to put an argument from the current goal context into another % goal. The coq.ltac.call utility can call Ltac1 code (written in Coq) and % pass arguments via this mechanism. % Last, since Elpi is alerady a logic programming language with primitive % support for unification variables, most of the work of a tactic can be % performed without using tacticals (which work on sealed goals) but rather % in the context of the original goal. The last step is typically to call % the refine utility with a term synthesized by the tactic or invoke some % Ltac1 code on that term (e.g. to call vm_compute, see also the example % on the reflexive tactic). % ----- Multi goals tactics. ---- % Coq provides goal selectors, such as all:, to pass to a tactic more than one % goal. In order to write such a tactic, Coq-Elpi provides another entry point % called msolve. To be precise, if there are two goals under focus, say and % , then all: elpi tac runs the following query % % msolve [,] NewGoals ; % note the disjunction % coq.ltac.all (coq.ltac.open solve) [,] NewGoals % % So, if msolve has no clause, Coq-Elpi will use solve on all the goals % independently. If msolve has a cluse, then it can manipulate the entire list % of sealed goals. Note that the argument is in both and but % it is interpreted in both contexts independently. If both goals have a proof % variable named "x" then passing (@eq_refl _ x) as equips both goals with % a (raw) proof that "x = x", no matter what their type is. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Declarations for Coq's API (environment read/write access, etc). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % tt = Yes, ff = No, unspecified = No (unspecified means "_" or a variable). typeabbrev opaque? bool. macro @opaque! :- tt. macro @transparent! :- ff. %%%%%%% Attributes to be passed to APIs as in @local! => coq.something %%%%%%%% macro @global! :- get-option "coq:locality" "global". macro @local! :- get-option "coq:locality" "local". macro @primitive! :- get-option "coq:primitive" tt. % primitive records macro @reversible! :- get-option "coq:reversible" tt. % coercions macro @no-tc! :- get-option "coq:no_tc" tt. % skip typeclass inference macro @uinstance! I :- get-option "coq:uinstance" I. % universe instance % declaration of universe polymorphic constants % The first list is the one of the unvierse variables being bound % The first boolean is tt if this list can be extended by Coq (or it has to % mention all universes actually used) % The second list if the one with the constaints amond where universes % The second boolean is tt if this list can be extended by Coq or it has to % mention all universe constraints actually required to type check the % declaration) macro @udecl! Vs LV Cs LC :- get-option "coq:udecl" (upoly-decl Vs LV Cs LC). macro @udecl-cumul! Vs LV Cs LC :- get-option "coq:udecl-cumul" (upoly-decl-cumul Vs LV Cs LC). macro @univpoly! :- @udecl! [] tt [] tt. macro @univpoly-cumul! :- @udecl-cumul! [] tt [] tt. macro @ppwidth! N :- get-option "coq:ppwidth" N. % printing width macro @ppall! :- get-option "coq:pp" "all". % printing all macro @ppmost! :- get-option "coq:pp" "most". % printing most of contents macro @pplevel! N :- get-option "coq:pplevel" N. % printing precedence (for parentheses) macro @keepunivs! :- get-option "coq:keepunivs" tt. % skeletons elaboration macro @dropunivs! :- get-option "coq:keepunivs" ff. % add-indt/add-const macro @using! S :- get-option "coq:using" S. % like the #[using=S] attribute macro @inline-at! N :- get-option "coq:inline" (coq.inline.at N). % like Inline(N) macro @inline! N :- get-option "coq:inline" coq.inline.default. % like macro @redflags! F :- get-option "coq:redflags" F. % for whd & co % both arguments are strings eg "8.12.0" "use foo instead" macro @deprecated! Since Msg :- get-option "coq:deprecated" (pr Since Msg). macro @ltacfail! N :- get-option "ltac:fail" N. % Declaration of inductive types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% kind indt-decl type. kind indc-decl type. kind record-decl type. % An arity is written, in Coq syntax, as: % (x : T1) .. (xn : Tn) : S1 -> ... -> Sn -> U % This syntax is used, for example, in the type of an inductive type or % in the type of constructors. We call the abstractions on the left of ":" % "parameters" while we call the type following the ":" (proper) arity. % Note: in some contexts, like the type of an inductive type constructor, % Coq makes no distinction between these two writings % (xn : Tn) : forall y1 : S1, ... and (xn : Tn) (y1 : S1) : ... % while Elpi is a bit more restrictive, since it understands user directives % such as the implicit status of an arguments (eg, using {} instead of () around % the binder), only on parameters. % Moreover parameters carry the name given by the user as an "id", while binders % in terms only carry it as a "name", an irrelevant pretty pringintg hint (see % also the HOAS of terms). A user command can hence only use the names of % parameters, and not the names of "forall" quantified variables in the arity. % % See also the arity->term predicate in coq-lib.elpi type parameter id -> implicit_kind -> term -> (term -> arity) -> arity. type arity term -> arity. type parameter id -> implicit_kind -> term -> (term -> indt-decl) -> indt-decl. type inductive id -> bool -> arity -> (term -> list indc-decl) -> indt-decl. % tt means inductive, ff coinductive type record id -> term -> id -> record-decl -> indt-decl. type constructor id -> arity -> indc-decl. type field field-attributes -> id -> term -> (term -> record-decl) -> record-decl. type end-record record-decl. % Example. % Remark that A is a regular parameter; y is a non-uniform parameter and t % also features an index of type bool. % % Inductive t (A : Type) | (y : nat) : bool -> Type := % | K1 (x : A) {n : nat} : S n = y -> t A n true -> t A y true % | K2 : t A y false % % is written % % (parameter "A" explicit {{ Type }} a\ % inductive "t" tt (parameter "y" explicit {{ nat }} _\ % arity {{ bool -> Type }}) % t\ % [ constructor "K1" % (parameter "y" explicit {{ nat }} y\ % (parameter "x" explicit a x\ % (parameter "n" maximal {{ nat }} n\ % arity {{ S lp:n = lp:y -> lp:t lp:n true -> lp:t lp:y true }}))) % , constructor "K2" % (parameter "y" explicit {{ nat }} y\ % arity {{ lp:t lp:y false }}) ]) % % Remark that the uniform parameters are not passed to occurrences of t, since % they never change, while non-uniform parameters are both abstracted % in each constructor type and passed as arguments to t. % % The coq.typecheck-indt-decl API can be used to fill in implicit arguments % an infer universe constraints in the declaration above (e.g. the hidden % argument of "=" in the arity of K1). % % Note: when and inductive type declaration is passed as an argument to an % Elpi command non uniform parameters must be separated from the uniform ones % with a | (a syntax introduced in Coq 8.12 and accepted by coq-elpi since % version 1.4, in Coq this separator is optional, but not in Elpi). % Context declaration (used as an argument to Elpi commands) kind context-decl type. % Eg. (x : T) or (x := B), body is optional, type may be a variable type context-item id -> implicit_kind -> term -> option term -> (term -> context-decl) -> context-decl. type context-end context-decl. typeabbrev field-attributes (list field-attribute). % retrocompatibility macro for Coq v8.10 macro @coercion! :- [coercion reversible]. % Attributes for a record field. Can be left unspecified, see defaults % below. kind field-attribute type. type coercion coercion-status -> field-attribute. % default off type canonical bool -> field-attribute. % default true, if field is named % Status of a record field w.r.t. coercions kind coercion-status type. type regular coercion-status. type reversible coercion-status. type off coercion-status. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% builtins %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the API to access Coq % The marker *E* means *experimental*, i.e. use at your own risk, it may change % substantially or even disappear in future versions. % -- Misc --------------------------------------------------------- % [coq.info ...] Prints an info message external type coq.info variadic any prop. % [coq.notice ...] Prints a notice message external type coq.notice variadic any prop. % [coq.say ...] Prints a notice message external type coq.say variadic any prop. % [coq.warn ...] Prints a generic warning message external type coq.warn variadic any prop. % [coq.warning Category Name ...] % Prints a warning message with a Name and Category which can be used % to silence this warning or turn it into an error. See coqc -w command % line option external type coq.warning string -> string -> variadic any prop. % [coq.error ...] Prints and *aborts* the program. It is a fatal error for % Elpi and Ltac external type coq.error variadic any prop. % [coq.version VersionString Major Minor Patch] Fetches the version of Coq, % as a string and as 3 numbers external pred coq.version o:string, o:int, o:int, o:int. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % API for objects belonging to the logic % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- Environment: names ----------------------------------------------- % To make the API more precise we use different data types for the names % of global objects. % Note: [ctype \"bla\"] is an opaque data type and by convention it is % written [@bla]. % Global constant name typeabbrev constant (ctype "constant"). % Inductive type name typeabbrev inductive (ctype "inductive"). % Inductive constructor name typeabbrev constructor (ctype "constructor"). % Global objects: inductive types, inductive constructors, definitions kind gref type. type const constant -> gref. % Nat.add, List.append, ... type indt inductive -> gref. % nat, list, ... type indc constructor -> gref. % O, S, nil, cons, ... % [id] is a name that matters, we piggy back on Elpi's strings. % Note: [name] is a name that does not matter. typeabbrev id string. % Name of a module /*E*/ typeabbrev modpath (ctype "modpath"). % Name of a module type /*E*/ typeabbrev modtypath (ctype "modtypath"). % -- Environment: read ------------------------------------------------ % Note: The type [term] is defined in coq-HOAS.elpi % Result of coq.locate-all kind located type. type loc-gref gref -> located. type loc-modpath modpath -> located. type loc-modtypath modtypath -> located. type loc-abbreviation abbreviation -> located. % [coq.locate-all Name Located] finds all possible meanings of a string. % Does not fail. external pred coq.locate-all i:id, o:list located. % [coq.locate Name GlobalReference] locates a global definition, inductive % type or constructor via its name. % It unfolds syntactic notations, e.g. "Notation old_name := new_name." % It undestands qualified names, e.g. "Nat.t". % It understands Coqlib Registered names using the "lib:" prefix, % eg "lib:core.bool.true". % It's a fatal error if Name cannot be located. external pred coq.locate i:id, o:gref. % [coq.env.typeof GR Ty] reads the type Ty of a global reference. % Supported attributes: % - @uinstance! I (default: fresh instance I) external pred coq.env.typeof i:gref, o:term. % [coq.env.global GR T] turns a global reference GR into a term, or % viceversa. % T = (global GR) or, if GR points to a universe polymorphic term, % T = (pglobal GR I). % Supported attributes: % - @uinstance! I (default: fresh instance I) external pred coq.env.global o:gref, o:term. external pred coq.env.indt % reads the inductive type declaration for the environment. % Supported attributes: % - @uinstance! I (default: fresh instance I) i:inductive, % reference to the inductive type o:bool, % tt if the type is inductive (ff for co-inductive) o:int, % number of parameters o:int, % number of parameters that are uniform (<= parameters) o:term, % type of the inductive type constructor including parameters o:list constructor, % list of constructor names o:list term. % list of the types of the constructors (type of KNames) including parameters external pred coq.env.indt-decl % reads the inductive type declaration for the environment. % Supported attributes: % - @uinstance! I (default: fresh instance I) i:inductive, % reference to the inductive type o:indt-decl. % HOAS description of the inductive type % [coq.env.indc->indt K I N] finds the inductive I to which constructor K % belongs and its position N among the other constructors external pred coq.env.indc->indt i:constructor, o:inductive, o:int. % [coq.env.indc GR ParamNo UnifParamNo Kno Ty] reads the type Ty of an % inductive constructor GR, as well as % the number of parameters ParamNo and uniform parameters % UnifParamNo and the number of the constructor Kno (0 based). % Supported attributes: % - @uinstance! I (default: fresh instance I) external pred coq.env.indc i:constructor, o:int, o:int, o:int, o:term. % [coq.env.informative? Ind] Checks if Ind is informative, that is, if % it can be eliminated to build a Type. Inductive types in Type % are % informative, as well a singleton types in Prop (which are % regarded as not non-informative). external pred coq.env.informative? i:inductive. % [coq.env.record? Ind PrimProjs] checks if Ind is a record (PrimProjs = tt % if Ind has primitive projections) external pred coq.env.record? i:inductive, o:bool. % [coq.env.recursive? Ind] checks if Ind is recursive external pred coq.env.recursive? i:inductive. % [coq.env.opaque? GR] checks if GR is an opaque constant external pred coq.env.opaque? i:constant. % [coq.env.univpoly? GR PolyArity] checks if GR is universe polymorphic and % if so returns the number of universe variables external pred coq.env.univpoly? i:gref, o:int. % [coq.env.const GR Bo Ty] reads the type Ty and the body Bo of constant % GR. % Opaque constants have Bo = none. % Supported attributes: % - @uinstance! I (default: fresh instance I) external pred coq.env.const i:constant, o:option term, o:term. % [coq.env.const-body GR Bo] reads the body of a constant, even if it is % opaque. % If such body is none, then the constant is a true axiom. % Supported attributes: % - @uinstance! I (default: fresh instance I) external pred coq.env.const-body i:constant, o:option term. % [coq.env.primitive? GR] tests if GR is a primitive constant (like uin63 % addition) or a primitive type (like uint63) external pred coq.env.primitive? i:constant. % [coq.locate-module ModName ModPath] locates a module. It's a fatal error % if ModName cannot be located. *E* external pred coq.locate-module i:id, o:modpath. % [coq.locate-module-type ModName ModPath] locates a module. It's a fatal % error if ModName cannot be located. *E* external pred coq.locate-module-type i:id, o:modtypath. % Contents of a module kind module-item type. type submodule modpath -> list module-item -> module-item. type module-type modtypath -> module-item. type gref gref -> module-item. type module-functor modpath -> list modtypath -> module-item. type module-type-functor modtypath -> list modtypath -> module-item. % [coq.env.module MP Contents] lists the contents of a module (recurses on % submodules) *E* external pred coq.env.module i:modpath, o:list module-item. % [coq.env.module-type MTP Entries] lists the items made visible by module % type (does not recurse on submodules) *E* external pred coq.env.module-type i:modtypath, o:list id. % [coq.env.section GlobalObjects] lists the global objects that are marked % as to be abstracted at the end of the enclosing sections external pred coq.env.section o:list constant. % [coq.env.dependencies GR MP Deps] Computes the direct dependencies of GR. % If MP is given, Deps only contains grefs from that module external pred coq.env.dependencies i:gref, i:modpath, o:coq.gref.set. % [coq.env.transitive-dependencies GR MP Deps] Computes the transitive % dependencies of GR. If MP is given, Deps only contains grefs from that % module external pred coq.env.transitive-dependencies i:gref, i:modpath, o:coq.gref.set. % [coq.env.term-dependencies T S] Computes all the grefs S occurring in the % term T external pred coq.env.term-dependencies i:term, o:coq.gref.set. % [coq.env.current-path Path] lists the current module path external pred coq.env.current-path o:list string. % [coq.env.current-section-path Path] lists the current section path external pred coq.env.current-section-path o:list string. % Deprecated, use coq.env.opaque? pred coq.env.const-opaque? i:constant. coq.env.const-opaque? C :- coq.warning "elpi.deprecated" "elpi.const-opaque" "use coq.env.opaque? in place of coq.env.const-opaque?", coq.env.opaque? C. % Deprecated, use coq.env.primitive? pred coq.env.const-primitive? i:constant. coq.env.const-primitive? C :- coq.warning "elpi.deprecated" "elpi.const-primitive" "use coq.env.primitive? in place of coq.env.const-primitive?", coq.env.primitive? C. % -- Environment: write ----------------------------------------------- % Note: (monomorphic) universe constraints are taken from ELPI's % constraints store. Use coq.univ-* in order to add constraints (or any % higher level facility as coq.typecheck). Load in the context attributes % such as @univpoly!, @univpoly-cumul!, @udecl! or @udecl-cumul! in order to % declare universe polymorphic constants or inductives. % [coq.env.add-const Name Bo Ty Opaque C] Declare a new constant: C gets a % constant derived from Name % and the current module; Ty can be left unspecified and in that case % the % inferred one is taken (as in writing Definition x := t); Bo can be % left % unspecified and in that case an axiom is added (or a section variable, % if a section is open and @local! is used). Omitting the body and the type % is % an error. Note: using this API for declaring an axiom or a section % variable is % deprecated, use coq.env.add-axiom or coq.env.add-section-variable % instead. % Supported attributes: % - @local! (default: false) % - @using! (default: section variables actually used) % - @univpoly! (default unset) % - @udecl! (default unset) % - @dropunivs! (default: false, drops all universe constraints from the % store after the definition) % external pred coq.env.add-const i:id, i:term, i:term, i:opaque?, o:constant. % [coq.env.add-axiom Name Ty C] Declare a new axiom: C gets a constant % derived from Name % and the current module. % Supported attributes: % - @local! (default: false) % - @univpoly! (default unset) % - @using! (default: section variables actually used) % - @inline! (default: no inlining) % - @inline-at! N (default: no inlining) external pred coq.env.add-axiom i:id, i:term, o:constant. % [coq.env.add-section-variable Name Ty C] Declare a new section variable: C % gets a constant derived from Name % and the current module external pred coq.env.add-section-variable i:id, i:term, o:constant. % [coq.env.add-indt Decl I] Declares an inductive type. % Supported attributes: % - @dropunivs! (default: false, drops all universe constraints from the % store after the definition) % - @primitive! (default: false, makes records primitive) external pred coq.env.add-indt i:indt-decl, o:inductive. % Interactive module construction % Coq Module inline directive kind coq.inline type. type coq.inline.no coq.inline. % Coq's [no inline] (aka !) type coq.inline.default coq.inline. % The default, can be omitted type coq.inline.at int -> coq.inline. % Coq's [inline at ] % [coq.env.fresh-global-id ID FID] Generates an id FID which is fresh in % the current module and looks similar to ID, i.e. it is ID concatenated % with a number, starting from 1. % [coq.env.fresh-global-id X X] can be used to check if X is taken external pred coq.env.fresh-global-id i:id, o:id. external pred coq.env.begin-module-functor % Starts a functor *E* i:id, % The name of the functor i:option modtypath, % Its module type i:list (pair id modtypath). % Parameters of the functor pred coq.env.begin-module i:id, i:option modtypath. coq.env.begin-module Name MP :- coq.env.begin-module-functor Name MP []. % [coq.env.end-module ModPath] end the current module that becomes known as % ModPath *E* external pred coq.env.end-module o:modpath. external pred coq.env.begin-module-type-functor % Starts a module type functor *E* i:id, % The name of the functor i:list (pair id modtypath). % The parameters of the functor pred coq.env.begin-module-type i:id. coq.env.begin-module-type Name :- coq.env.begin-module-type-functor Name []. % [coq.env.end-module-type ModTyPath] end the current module type that % becomes known as ModPath *E* external pred coq.env.end-module-type o:modtypath. external pred coq.env.apply-module-functor % Applies a functor *E* i:id, % The name of the new module i:option modtypath, % Its module type i:modpath, % The functor being applied i:list modpath, % Its arguments i:coq.inline, % Arguments inlining o:modpath. % The modpath of the new module external pred coq.env.apply-module-type-functor % Applies a type functor *E* i:id, % The name of the new module type i:modtypath, % The functor i:list modpath, % Its arguments i:coq.inline, % Arguments inlining o:modtypath. % The modtypath of the new module type % [coq.env.include-module ModPath Inline] is like the vernacular Include, % Inline can be omitted *E* external pred coq.env.include-module i:modpath, i:coq.inline. % [coq.env.include-module-type ModTyPath Inline] is like the vernacular % Include Type, Inline can be omitted *E* external pred coq.env.include-module-type i:modtypath, i:coq.inline. % [coq.env.import-module ModPath] is like the vernacular Import *E* external pred coq.env.import-module i:modpath. % [coq.env.export-module ModPath] is like the vernacular Export *E* external pred coq.env.export-module i:modpath. % Support for sections is limited, in particular sections and % Coq quotations may interact in surprising ways. For example % Section Test. % Variable x : nat. % Elpi Query lp:{{ coq.say {{ x }} }}. % works since x is a global Coq term while % Elpi Query lp:{{ % coq.env.begin-section "Test", % coq.env.add-const "x" _ {{ nat }} _ @local! GRX, % coq.say {{ x }} % }}. % may work in a surprising way or may not work at all since % x is resolved before the section is started hence it cannot % denote the same x as before. % [coq.env.begin-section Name] starts a section named Name *E* external pred coq.env.begin-section i:id. % [coq.env.end-section] end the current section *E* external pred coq.env.end-section . % [coq.env.projections StructureName Projections] given a record % StructureName lists all projections external pred coq.env.projections i:inductive, o:list (option constant). % [coq.env.primitive-projections StructureName Projections] given a record % StructureName lists all primitive projections external pred coq.env.primitive-projections i:inductive, o:list (option (pair projection int)). % -- Sorts (and their universe level, if applicable) ---------------- % Warning: universe polymorphism has to be considered experimental *E* as % a feature, not just as a set of APIs. Unfortunately some of the % current complexity is exposed to the programmer, bare with us. % % The big bang is that in Coq one has terms, types and sorts (which are % the types of types). Some sorts (as of today only Type) some with % a universe level, on paper Type_i for some i. At the sort level % Coq features some form of subtyping: a function expecting a function % to Type, e.g. nat -> Type, can receive a function to Prop, since % Prop <= Type. So far, so good. But what are these levels i % exactly? % % Universe levels are said to be "algebraic", they are made of % variables (see the next section) and the two operators +1 and max. % This is a sort of internal optimization that leaks to the % user/programmer. Indeed these universe levels cannot be (directly) used % in all APIs morally expecting a universe level "i", in particular % the current constraint engine cannot handle constraint with an % algebraic level on the right, e.g. i <= j+1. Since some APIs only % accept universe variables, we provide the coq.univ.variable API % which is able to craft a universe variable which is roughly % equivalent to an algebraic universe, e.g. k such that j+1 = k. % % Coq-Elpi systematically purges algebraic universes from terms (and % types and sorts) when one reads them from the environment. This % makes the embedding of terms less precise than what it could be. % The different data types stay, since Coq will eventually become % able to handle algebraic universes consistently, making this purging % phase unnecessary. % universe level (algebraic: max, +1, univ.variable) typeabbrev univ (ctype "univ"). % Sorts (kinds of types) kind sort type. type prop sort. % impredicative sort of propositions type sprop sort. % impredicative sort of propositions with definitional proof irrelevance type typ univ -> sort. % predicative sort of data (carries a universe level) % [coq.sort.leq S1 S2] constrains S1 <= S2 external pred coq.sort.leq o:sort, o:sort. % [coq.sort.eq S1 S2] constrains S1 = S2 external pred coq.sort.eq o:sort, o:sort. % [coq.sort.sup S1 S2] constrains S2 = S1 + 1 external pred coq.sort.sup o:sort, o:sort. % [coq.sort.pts-triple S1 S2 S3] constrains S3 = sort of product with domain % in S1 and codomain in S2 external pred coq.sort.pts-triple o:sort, o:sort, o:sort. % [coq.univ.print] prints the set of universe constraints external pred coq.univ.print . % [coq.univ.new U] A fresh universe. external pred coq.univ.new o:univ. % [coq.univ Name U] Finds a named unvierse. Can fail. external pred coq.univ o:id, o:univ. % [coq.univ.global? U] succeeds if U is a global universe external pred coq.univ.global? i:univ. % [coq.univ.constraints CL] gives the list of constraints, see also % coq.univ.variable.constraints external pred coq.univ.constraints o:list univ-constraint. % -- Universe variables ------ % universe level variable typeabbrev univ.variable (ctype "univ.variable"). % [coq.univ.variable U L] relates a univ.variable L to a univ U external pred coq.univ.variable o:univ, o:univ.variable. % [coq.univ.variable.constraints L CL] gives the list of constraints on L. % Can be used to craft a strict upoly-decl external pred coq.univ.variable.constraints i:univ.variable, o:list univ-constraint. % [coq.univ.variable.of-term T S] collects all univ.variables occurring in T external pred coq.univ.variable.of-term i:term, o:coq.univ.variable.set. % -- Universe instance (for universe polymorphic global terms) ------ % As of today a universe polymorphic constant can only be instantiated % with universe level variables. That is f@{Prop} is not valid, nor % is f@{u+1}. One can only write f@{u} for any u. % % A univ-instance is morally a list of universe level variables, % but its list syntax is hidden in the terms. If you really need to % craft or inspect one of these, the following APIs can help you. % % Most of the time the user is expected to use coq.env.global which % crafts a fresh, appropriate, universe instance and possibly unify that % term (of the instance it contains) with another one. % Universes level instance for a universe-polymoprhic constant typeabbrev univ-instance (ctype "univ-instance"). % [coq.univ-instance UI UL] relates a univ-instance UI and a list of % universe level variables UL external pred coq.univ-instance o:univ-instance, o:list univ.variable. % [coq.univ-instance.unify-eq GR UI1 UI2 Diagnostic] unifies the two % universe instances for the same gref external pred coq.univ-instance.unify-eq i:gref, i:univ-instance, i:univ-instance, o:diagnostic. % [coq.univ-instance.unify-leq GR UI1 UI2 Diagnostic] unifies the two % universe instances for the same gref. Note: if the GR is not *cumulative* % (see Cumulative or #[universes(cumulative)]) then this API imposes an % equality constraint. external pred coq.univ-instance.unify-leq i:gref, i:univ-instance, i:univ-instance, o:diagnostic. % -- Declaration of universe polymorphic global terms ----------- % These are the data types used to declare how constants % and inductive types should be declared (see also the @udecl! % and % @udecl-cumul! macros). Note that only inductive types can be % declared as cumulative. % Constraint between two universes level variables kind univ-constraint type. type lt univ.variable -> univ.variable -> univ-constraint. type le univ.variable -> univ.variable -> univ-constraint. type eq univ.variable -> univ.variable -> univ-constraint. % Variance of a universe level variable kind univ-variance type. type auto univ.variable -> univ-variance. type covariant univ.variable -> univ-variance. type invariant univ.variable -> univ-variance. type irrelevant univ.variable -> univ-variance. % Constraints for a non-cumulative declaration. Boolean tt means loose % (e.g. the '+' in f@{u v + | u < v +}) kind upoly-decl type. type upoly-decl list univ.variable -> bool -> list univ-constraint -> bool -> upoly-decl. % Constraints for a cumulative declaration. Boolean tt means loose (e.g. % the '+' in f@{u v + | u < v +}) kind upoly-decl-cumul type. type upoly-decl-cumul list univ-variance -> bool -> list univ-constraint -> bool -> upoly-decl-cumul. % -- Primitive -------------------------------------------------------- typeabbrev uint63 (ctype "uint63"). typeabbrev float64 (ctype "float64"). typeabbrev projection (ctype "projection"). % Primitive values kind primitive-value type. type uint63 uint63 -> primitive-value. % unsigned integers over 63 bits type float64 float64 -> primitive-value. % double precision foalting points type proj projection -> int -> primitive-value. % primitive projection % [coq.uint63->int U I] Transforms a primitive unsigned integer U into an % elpi integer I. Fails if it does not fit. external pred coq.uint63->int i:uint63, o:int. % [coq.int->uint63 I U] Transforms an elpi integer I into a primitive % unsigned integer U. Fails if I is negative. external pred coq.int->uint63 i:int, o:uint63. % [coq.float64->float F64 F] Transforms a primitive float on 64 bits to an % elpi one. Currently, it should not fail. external pred coq.float64->float i:float64, o:float. % [coq.float->float64 F F64] Transforms an elpi float F to a primitive float % on 64 bits. Currently, it should not fail. external pred coq.float->float64 i:float, o:float64. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % API for extra logical objects % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- Databases (TC, CS, Coercions) ------------------------------------ % Pattern for canonical values kind cs-pattern type. type cs-gref gref -> cs-pattern. type cs-prod cs-pattern. type cs-default cs-pattern. type cs-sort sort -> cs-pattern. % Canonical Structure instances: (cs-instance Proj ValPat Inst) kind cs-instance type. type cs-instance gref -> cs-pattern -> gref -> cs-instance. % [coq.CS.declare-instance GR] Declares GR as a canonical structure % instance. % Supported attributes: % - @local! (default: false) external pred coq.CS.declare-instance i:gref. % [coq.CS.db Db] reads all instances external pred coq.CS.db o:list cs-instance. % [coq.CS.db-for Proj Value Db] reads all instances for a given Projection % or canonical Value, or both external pred coq.CS.db-for i:gref, i:cs-pattern, o:list cs-instance. % [coq.TC.declare-class GR] Declare GR as a type class external pred coq.TC.declare-class i:gref. % Type class instance with priority kind tc-instance type. type tc-instance gref -> int -> tc-instance. % [coq.TC.declare-instance GR Priority] Declare GR as a Global type class % instance with Priority. % Supported attributes: % - @global! (default: true) external pred coq.TC.declare-instance i:gref, i:int. % [coq.TC.db Instances] reads all type class instances external pred coq.TC.db o:list tc-instance. % [coq.TC.db-tc TypeClasses] reads all type classes external pred coq.TC.db-tc o:list gref. % [coq.TC.db-for GR Db] reads all instances of the given class GR external pred coq.TC.db-for i:gref, o:list tc-instance. % [coq.TC.class? GR] checks if GR is a class external pred coq.TC.class? i:gref. % Node of the coercion graph kind class type. type funclass class. type sortclass class. type grefclass gref -> class. % Edge of the coercion graph kind coercion type. type coercion gref -> int -> gref -> class -> coercion. % ref, nparams, src, tgt % [coq.coercion.declare C] Declares C = (coercion GR NParams From To) as a % coercion From >-> To. % NParams can always be omitted, since it is inferred. % If From or To is unspecified, then the endpoints are inferred. % Supported attributes: % - @global! (default: false) % - @nonuniform! (default: false) % - @reversible! (default: false) external pred coq.coercion.declare i:coercion. % [coq.coercion.db L] reads all declared coercions external pred coq.coercion.db o:list coercion. % [coq.coercion.db-for From To L] L is a path From -> To external pred coq.coercion.db-for i:class, i:class, o:list (pair gref int). % Deprecated, use coq.env.projections pred coq.CS.canonical-projections i:inductive, o:list (option constant). coq.CS.canonical-projections I L :- coq.warning "elpi.deprecated" "elpi.canonical-projections" "use coq.env.projections in place of coq.CS.canonical-projections", coq.env.projections I L. % -- Coq's Hint DB ------------------------------------- % Locality of hints is a delicate matter since the Coq default % is, in some cases, to make an hint active even if the module it belongs % to is not imported (just merely required, which can happen % transitively). % Coq is aiming at changing the default to #[export], that makes an % hint active only when its enclosing module is imported. % See: % https://coq.discourse.group/t/change-of-default-locality-for-hint-commands-in-coq-8-13/1140 % % This old behavior is available via the @global! flag, but is discouraged. % % Hint Mode kind hint-mode type. type mode-ground hint-mode. % No Evar type mode-input hint-mode. % No Head Evar type mode-output hint-mode. % Anything % [coq.hints.add-mode GR DB Mode] Adds a mode declaration to DB about % GR. % Supported attributes: % - @local! (default is export) % - @global! (discouraged, may become deprecated) external pred coq.hints.add-mode i:gref, i:string, i:list hint-mode. % [coq.hints.modes GR DB Modes] Gets all the mode declarations in DB about % GR external pred coq.hints.modes i:gref, i:string, o:list (list hint-mode). % [coq.hints.set-opaque C DB Opaque] Like Hint Opaque C : DB (or Hint % Transparent, if the boolean is ff). % Supported attributes: % - @local! (default is export) % - @global! (discouraged, may become deprecated) external pred coq.hints.set-opaque i:constant, i:string, i:bool. % [coq.hints.opaque C DB Opaque] Reads if constant C is opaque (tt) or % transparent (ff) in DB external pred coq.hints.opaque i:constant, i:string, o:bool. % [coq.hints.add-resolve GR DB Priority Pattern] Like Hint Resolve GR | % Priority Pattern : DB. % Supported attributes: % - @local! (default is export) % - @global! (discouraged, may become deprecated) external pred coq.hints.add-resolve i:gref, i:string, i:int, i:term. % -- Coq's notational mechanisms ------------------------------------- % Implicit status of an argument kind implicit_kind type. type implicit implicit_kind. % regular implicit argument, eg Arguments foo [x] type maximal implicit_kind. % maximally inserted implicit argument, eg Arguments foo {x} type explicit implicit_kind. % explicit argument, eg Arguments foo x % [coq.arguments.implicit GR Imps] reads the implicit arguments declarations % associated to a global reference. See also the [] and {} flags for the % Arguments command. external pred coq.arguments.implicit i:gref, o:list (list implicit_kind). % [coq.arguments.set-implicit GR Imps] sets the implicit arguments % declarations associated to a global reference. % Unspecified means explicit. % See also the [] and {} flags for the Arguments command. % Supported attributes: % - @global! (default: false) external pred coq.arguments.set-implicit i:gref, i:list (list implicit_kind). % [coq.arguments.set-default-implicit GR] sets the default implicit % arguments declarations associated to a global reference. % See also the "default implicits" flag to the Arguments command. % Supported attributes: % - @global! (default: false) external pred coq.arguments.set-default-implicit i:gref. % [coq.arguments.name GR Names] reads the Names of the arguments of a global % reference. See also the (f (A := v)) syntax. external pred coq.arguments.name i:gref, o:list (option id). % [coq.arguments.set-name GR Names] sets the Names of the arguments of a % global reference. % See also the :rename flag to the Arguments command. % Supported attributes: % - @global! (default: false) external pred coq.arguments.set-name i:gref, i:list (option id). % [coq.arguments.scope GR Scopes] reads the notation scope of the arguments % of a global reference. See also the %scope modifier for the Arguments % command external pred coq.arguments.scope i:gref, o:list (list id). % [coq.arguments.set-scope GR Scopes] sets the notation scope of the % arguments of a global reference. % Scope can be a scope name or its delimiter. % See also the %scope modifier for the Arguments command. % Supported attributes: % - @global! (default: false) external pred coq.arguments.set-scope i:gref, i:list (list id). % Strategy for simplification tactics kind simplification_strategy type. type never simplification_strategy. % Arguments foo : simpl never type when list int -> option int -> simplification_strategy. % Arguments foo .. / .. ! .. type when-nomatch list int -> option int -> simplification_strategy. % Arguments foo .. / .. ! .. : simpl nomatch % [coq.arguments.simplification GR Strategy] reads the behavior of the % simplification tactics. Positions are 0 based. See also the ! and / % modifiers for the Arguments command external pred coq.arguments.simplification i:gref, o:option simplification_strategy. % [coq.arguments.set-simplification GR Strategy] sets the behavior of the % simplification tactics. % Positions are 0 based. % See also the ! and / modifiers for the Arguments command. % Supported attributes: % - @global! (default: false) external pred coq.arguments.set-simplification i:gref, i:simplification_strategy. % [coq.locate-abbreviation Name Abbreviation] locates an abbreviation. It's % a fatal error if Name cannot be located. external pred coq.locate-abbreviation i:id, o:abbreviation. % Name of an abbreviation typeabbrev abbreviation (ctype "abbreviation"). % [coq.notation.add-abbreviation Name Nargs Body OnlyParsing Abbreviation] % Declares an abbreviation Name with Nargs arguments. % The term must begin with at least Nargs "fun" nodes whose domain is % ignored, eg (fun _ _ x\ fun _ _ y\ app[global "add",x,y]). % Supported attributes: % - @deprecated! (default: not deprecated) % - @global! (default: false) external pred coq.notation.add-abbreviation i:id, i:int, i:term, i:bool, o:abbreviation. % [coq.notation.abbreviation Abbreviation Args Body] Unfolds an abbreviation external pred coq.notation.abbreviation i:abbreviation, i:list term, o:term. % [coq.notation.abbreviation-body Abbreviation Nargs Body] Retrieves the % body of an abbreviation external pred coq.notation.abbreviation-body i:abbreviation, o:int, o:term. % [coq.notation.add-abbreviation-for-tactic Name TacticName FixedArgs] % Declares a parsing rule similar to % Notation Name X1..Xn := ltac:(elpi TacticName FixedArgs (X1)..(Xn)) % so that Name can be used in the middle of a term to invoke an % elpi tactic. While FixedArgs can contain str, int, and trm all % other arguments will necessarily be terms, and their number is % not fixed (the user can pass as many as he likes). % The tactic receives as the elpi.loc attribute the precise location % at which the term is written (unlike if a regular abbreviation was % declared by hand). % A call to coq.notation.add-abbreviation-for-tactic TacName TacName [] % is equivalent to Elpi Export TacName. external pred coq.notation.add-abbreviation-for-tactic i:string, i:string, i:list argument. % Generic attribute value kind attribute-value type. type leaf-str string -> attribute-value. type leaf-loc loc -> attribute-value. type node list attribute -> attribute-value. % Generic attribute kind attribute type. type attribute string -> attribute-value -> attribute. % see coq-lib.elpi for coq.parse-attributes generating the options below type get-option string -> A -> prop. % -- Coq's pretyper --------------------------------------------------- % [coq.sigma.print] Prints Coq's Evarmap and the mapping to/from Elpi's % unification variables external pred coq.sigma.print . % [coq.typecheck T Ty Diagnostic] typchecks a term T returning its type Ty. % If Ty is provided, then % the inferred type is unified (see unify-leq) with it. % Universe constraints are put in the constraint store. external pred coq.typecheck i:term, o:term, o:diagnostic. % [coq.typecheck-ty Ty U Diagnostic] typchecks a type Ty returning its % universe U. If U is provided, then % the inferred universe is unified (see unify-leq) with it. % Universe constraints are put in the constraint store. external pred coq.typecheck-ty i:term, o:sort, o:diagnostic. % [coq.unify-eq A B Diagnostic] unifies the two terms external pred coq.unify-eq i:term, i:term, o:diagnostic. % [coq.unify-leq A B Diagnostic] unifies the two terms (with cumulativity, % if they are types) external pred coq.unify-leq i:term, i:term, o:diagnostic. % [coq.elaborate-skeleton T ETy E Diagnostic] elabotares T against the % expected type ETy. % T is allowed to contain holes (unification variables) but these are % not assigned even if the elaborated term has a term in place of the % hole. Similarly universe levels present in T are disregarded. % Supported attributes: % - @keepunivs! (default false, do not disregard universe levels) % - @no-tc! (default false, do not infer typeclasses) external pred coq.elaborate-skeleton i:term, o:term, o:term, o:diagnostic. % [coq.elaborate-ty-skeleton T U E Diagnostic] elabotares T expecting it to % be a type of sort U. % T is allowed to contain holes (unification variables) but these are % not assigned even if the elaborated term has a term in place of the % hole. Similarly universe levels present in T are disregarded. % Supported attributes: % - @keepunivs! (default false, do not disregard universe levels) % - @no-tc! (default false, do not infer typeclasses) external pred coq.elaborate-ty-skeleton i:term, o:sort, o:term, o:diagnostic. % -- Coq's reduction flags ------------------------------------ % Flags for lazy, cbv, ... reductions kind coq.redflag type. type coq.redflags.beta coq.redflag. type coq.redflags.delta coq.redflag. % if set then coq.redflags.const disables unfolding type coq.redflags.match coq.redflag. type coq.redflags.fix coq.redflag. type coq.redflags.cofix coq.redflag. type coq.redflags.zeta coq.redflag. type coq.redflags.const constant -> coq.redflag. % enable/disable unfolding % Set of flags for lazy, cbv, ... reductions typeabbrev coq.redflags (ctype "coq.redflags"). type coq.redflags.all coq.redflags. type coq.redflags.allnolet coq.redflags. type coq.redflags.beta coq.redflags. type coq.redflags.betadeltazeta coq.redflags. type coq.redflags.betaiota coq.redflags. type coq.redflags.betaiotazeta coq.redflags. type coq.redflags.betazeta coq.redflags. type coq.redflags.delta coq.redflags. type coq.redflags.zeta coq.redflags. type coq.redflags.nored coq.redflags. % [coq.redflags.add Flags Options NewFlags] Updates reduction Flags by % adding Options external pred coq.redflags.add i:coq.redflags, i:list coq.redflag, o:coq.redflags. % [coq.redflags.sub Flags Options NewFlags] Updates reduction Flags by % removing Options external pred coq.redflags.sub i:coq.redflags, i:list coq.redflag, o:coq.redflags. % -- Coq's reduction machines ------------------------------------ % [coq.reduction.lazy.whd T Tred] Puts T in weak head normal form. % Supported attributes: % - @redflags! (default coq.redflags.all) external pred coq.reduction.lazy.whd i:term, o:term. % [coq.reduction.lazy.norm T Tred] Puts T in normal form. % Supported attributes: % - @redflags! (default coq.redflags.all) external pred coq.reduction.lazy.norm i:term, o:term. % [coq.reduction.lazy.bi-norm T Tred] Puts T in normal form only reducing % beta and iota redexes external pred coq.reduction.lazy.bi-norm i:term, o:term. % [coq.reduction.cbv.norm T Tred] Puts T in normal form using the call by % value strategy. % Supported attributes: % - @redflags! (default coq.redflags.all) external pred coq.reduction.cbv.norm i:term, o:term. % [coq.reduction.vm.norm T Ty Tred] Puts T in normal form using % [vm_compute]'s machinery. Its type Ty can be omitted (but is recomputed) external pred coq.reduction.vm.norm i:term, i:term, o:term. % [coq.reduction.native.norm T Ty Tred] Puts T in normal form using % [native_compute]'s machinery. Its type Ty can be omitted (but is % recomputed). Falls back to vm.norm if native compilation is not available. external pred coq.reduction.native.norm i:term, i:term, o:term. % [coq.reduction.native.available?] Is native compilation available on this % system/configuration? external pred coq.reduction.native.available? . % Deprecated, use coq.reduction.cbv.norm pred coq.reduction.cbv.whd_all i:term, o:term. coq.reduction.cbv.whd_all T R :- coq.warning "elpi.deprecated" "elpi.cbv-whd-all" "use coq.reduction.cbv.norm in place of coq.reduction.cbv.whd_all", coq.reduction.cbv.norm T R. % Deprecated, use coq.reduction.vm.norm pred coq.reduction.vm.whd_all i:term, i:term, o:term. coq.reduction.vm.whd_all T TY R :- coq.warning "elpi.deprecated" "elpi.vm-whd-all" "use coq.reduction.vm.norm in place of coq.reduction.vm.whd_all", coq.reduction.vm.norm T TY R. pred coq.reduction.lazy.whd_all i:term, o:term. coq.reduction.lazy.whd_all X Y :- @redflags! coq.redflags.all => coq.reduction.lazy.whd X Y. % [coq.reduction.eta-contract T Tred] Removes all eta expansions from T external pred coq.reduction.eta-contract i:term, o:term. % -- Coq's conversion strategy tweaks -------------------------- % Strategy for conversion test % expand < ... < level -1 < level 0 < level 1 < ... < opaque kind conversion_strategy type. type opaque conversion_strategy. type expand conversion_strategy. type level int -> conversion_strategy. % default is 0, aka transparent % [coq.strategy.set CL Level] Sets the unfolding priority for all the % constants in the list CL. See the command Strategy. external pred coq.strategy.set i:list constant, i:conversion_strategy. % [coq.strategy.get C Level] Gets the unfolding priority for C external pred coq.strategy.get i:constant, o:conversion_strategy. % -- Coq's tactics -------------------------------------------- % LTac1 tactic expression typeabbrev ltac1-tactic (ctype "ltac1-tactic"). % [coq.ltac.fail Level ...] Interrupts the Elpi program and calls Ltac's % fail Level Msg, where Msg is the printing of the remaining arguments. % Level can be left unspecified and defaults to 0 external type coq.ltac.fail int -> variadic any prop. % [coq.ltac.collect-goals T Goals ShelvedGoals] % Turns the holes in T into Goals. % Goals are closed with nablas. % ShelvedGoals are goals which can be solved by side effect (they occur % in the type of the other goals). % The order of Goals is given by the traversal order of EConstr.fold % (a % fold_left over the terms, letin body comes before the type). % external pred coq.ltac.collect-goals i:term, o:list sealed-goal, o:list sealed-goal. % [coq.ltac.call-ltac1 Tac G GL] Calls Ltac1 tactic Tac on goal G (passing % the arguments of G, see coq.ltac.call for a handy wrapper). % Tac can either be a string (the tactic name), or a value % of type ltac1-tactic, see the tac argument constructor % and the ltac_tactic:(...) syntax to pass arguments to % an elpi tactic. external pred coq.ltac.call-ltac1 i:any, i:goal, o:list sealed-goal. % [coq.ltac.id-free? ID G] % Fails if ID is already used in G. Note that ids which are taken are % renamed % on the fly (since in the HOAS of terms, names are just pretty printing % hints), but for the ergonomy of a tactic it may help to know if an % hypothesis name is already taken. % external pred coq.ltac.id-free? i:id, i:goal. % -- Coq's options system -------------------------------------------- % Coq option value kind coq.option type. type coq.option.int option int -> coq.option. % none means unset type coq.option.string option string -> coq.option. % none means unset type coq.option.bool bool -> coq.option. % [coq.option.get Option Value] reads Option. Reading a non existing option % is a fatal error. external pred coq.option.get i:list string, o:coq.option. % [coq.option.set Option Value] writes Option. Writing a non existing option % is a fatal error. external pred coq.option.set i:list string, i:coq.option. % [coq.option.available? Option Deprecated] checks if Option exists and % tells if is deprecated (tt) or not (ff) external pred coq.option.available? i:list string, o:bool. % [coq.option.add Option Value Deprecated] % adds a new option to Coq setting its current value (and type). % Deprecated can be left unspecified and defaults to ff. % This call cannot be undone in a Coq interactive session, use it once % and for all in a .v file which your clients will load. Eg. % % Elpi Query lp:{{ coq.option.add ... }}. % % external pred coq.option.add i:list string, i:coq.option, i:bool. % -- Datatypes conversions -------------------------------------------- % Name.Name.t: Name hints (in binders), can be input writing a name % between backticks, e.g. `x` or `_` for anonymous. Important: these are % just printing hints with no meaning, hence in elpi two name are always % related: `x` = `y` typeabbrev name (ctype "name"). % [coq.name-suffix Name Suffix NameSuffix] suffixes a Name with a string or % an int or another name external pred coq.name-suffix i:name, i:any, o:name. % [coq.string->name Hint Name] creates a name hint external pred coq.string->name i:string, o:name. pred coq.id->name i:id, o:name. coq.id->name S N :- coq.string->name S N. % [coq.name->id Name Id] tuns a pretty printing hint into a string. This API % is for internal use, no guarantee on its behavior. external pred coq.name->id i:name, o:id. % [coq.gref->id GR Id] extracts the label (last component of a full kernel % name) external pred coq.gref->id i:gref, o:id. % [coq.gref->string GR FullPath] extract the full kernel name external pred coq.gref->string i:gref, o:string. % [coq.gref->path GR FullPath] extract the full path (kernel name without % final id), each component is a separate list item external pred coq.gref->path i:gref, o:list string. % [coq.modpath->path MP FullPath] extract the full kernel name, each % component is a separate list item external pred coq.modpath->path i:modpath, o:list string. % [coq.modtypath->path MTP FullPath] extract the full kernel name, each % component is a separate list item external pred coq.modtypath->path i:modtypath, o:list string. % [coq.modpath->library MP LibraryPath] extract the enclosing module which % can be Required external pred coq.modpath->library i:modpath, o:modpath. % [coq.modtypath->library MTP LibraryPath] extract the enclosing module % which can be Required external pred coq.modtypath->library i:modtypath, o:modpath. % [coq.term->string T S] prints a term T to a string S using Coq's pretty % printer % Supported attributes: % - @ppwidth! N (default 80, max line length) % - @ppall! (default: false, prints all details) % - @ppmost! (default: false, prints most details) % - @pplevel! (default: _, prints parentheses to reach that level, 200 = % off) % - @holes! (default: false, prints evars as _) external pred coq.term->string i:term, o:string. % [coq.term->pp T B] prints a term T to a pp.t B using Coq's pretty % printer" % Supported attributes: % - @ppall! (default: false, prints all details) % - @ppmost! (default: false, prints most details) % - @pplevel! (default: _, prints parentheses to reach that level, 200 = % off) % - @holes! (default: false, prints evars as _) external pred coq.term->pp i:term, o:coq.pp. % -- Access to Elpi's data -------------------------------------------- % clauses % % A clause like % :name "foo" :before "bar" foo X Y :- bar X Z, baz Z Y % is represented as % clause "foo" (before "bar") (pi x y z\ foo x y :- bar x z, baz z y) % that is exactly what one would load in the context using =>. % % The name and the grafting specification can be left unspecified. kind clause type. type clause id -> grafting -> prop -> clause. % Specify if the clause has to be grafted before or after a named clause kind grafting type. type before id -> grafting. type after id -> grafting. % Specify to which module the clause should be attached to kind scope type. type execution-site scope. % The module inside which the Elpi program is run type current scope. % The module being defined (see begin/end-module) type library scope. % The outermost module (carrying the file name) % see coq.elpi.accumulate-clauses pred coq.elpi.accumulate i:scope, i:id, i:clause. coq.elpi.accumulate S N C :- coq.elpi.accumulate-clauses S N [C]. % [coq.elpi.accumulate-clauses Scope DbName Clauses] % Declare that, once the program is over, the given clauses has to be % added to the given db (see Elpi Db). % Clauses usually belong to Coq modules: the Scope argument lets one % select which module: % - execution site (default) is the module in which the pogram is % invoked % - current is the module currently being constructed (see % begin/end-module) % - library is the current file (the module that is named after the file) % The clauses are visible as soon as the enclosing module is Imported. % A clause that mentions a section variable is automatically discarded % at the end of the section. % Clauses cannot be accumulated inside functors. % Supported attributes: % - @local! (default: false, discard at the end of section or module) % - @global! (default: false, always active, only if Scope is % execution-site, discouraged) external pred coq.elpi.accumulate-clauses i:scope, i:id, i:list clause. % Specify if a predicate argument is in input or output mode kind argument_mode type. type in argument_mode. type out argument_mode. % [coq.elpi.add-predicate Db Indexing PredName Spec] Declares a new % predicate PredName in the data base Db. Indexing can be left unspecified. % Spec gathers a mode and a type for each argument. CAVEAT: types and % indexing are strings instead of proper data types; beware parsing errors % are fatal external pred coq.elpi.add-predicate i:string, i:string, i:string, i:list (pair argument_mode string). % [coq.elpi.predicate PredName Args Pred] Pred is the application of % PredName to Args external pred coq.elpi.predicate i:string, i:list any, o:prop. % -- Utils ------------------------------------------------------------ kind coq.gref.set type. % [coq.gref.set.empty A] The empty set external pred coq.gref.set.empty o:coq.gref.set. % [coq.gref.set.mem Elem A] Checks if Elem is in a external pred coq.gref.set.mem i:gref, i:coq.gref.set. % [coq.gref.set.add Elem A B] B is A union {Elem} external pred coq.gref.set.add i:gref, i:coq.gref.set, o:coq.gref.set. % [coq.gref.set.remove Elem A B] B is A \ {Elem} external pred coq.gref.set.remove i:gref, i:coq.gref.set, o:coq.gref.set. % [coq.gref.set.union A B X] X is A union B external pred coq.gref.set.union i:coq.gref.set, i:coq.gref.set, o:coq.gref.set. % [coq.gref.set.inter A B X] X is A intersection B external pred coq.gref.set.inter i:coq.gref.set, i:coq.gref.set, o:coq.gref.set. % [coq.gref.set.diff A B X] X is A \ B external pred coq.gref.set.diff i:coq.gref.set, i:coq.gref.set, o:coq.gref.set. % [coq.gref.set.equal A B] tests A and B for equality external pred coq.gref.set.equal i:coq.gref.set, i:coq.gref.set. % [coq.gref.set.subset A B] tests if A is a subset of B external pred coq.gref.set.subset i:coq.gref.set, i:coq.gref.set. % [coq.gref.set.elements M L] L is M transformed into list external pred coq.gref.set.elements i:coq.gref.set, o:list gref. % [coq.gref.set.cardinal M N] N is the number of elements of M external pred coq.gref.set.cardinal i:coq.gref.set, o:int. % CAVEAT: the type parameter of coq.gref.map must be a closed term kind coq.gref.map type -> type. % [coq.gref.map.empty M] The empty map external pred coq.gref.map.empty o:coq.gref.map A. % [coq.gref.map.mem S M] Checks if S is bound in M external pred coq.gref.map.mem i:gref, i:coq.gref.map A. % [coq.gref.map.add S V M M1] M1 is M where V is bound to S external pred coq.gref.map.add i:gref, i:A, i:coq.gref.map A, o:coq.gref.map A. % [coq.gref.map.remove S M M1] M1 is M where S is unbound external pred coq.gref.map.remove i:gref, i:coq.gref.map A, o:coq.gref.map A. % [coq.gref.map.find S M V] V is the binding of S in M external pred coq.gref.map.find i:gref, i:coq.gref.map A, o:A. % [coq.gref.map.bindings M L] L is M transformed into an associative list external pred coq.gref.map.bindings i:coq.gref.map A, o:list (pair gref A). kind coq.univ.set type. % [coq.univ.set.empty A] The empty set external pred coq.univ.set.empty o:coq.univ.set. % [coq.univ.set.mem Elem A] Checks if Elem is in a external pred coq.univ.set.mem i:univ, i:coq.univ.set. % [coq.univ.set.add Elem A B] B is A union {Elem} external pred coq.univ.set.add i:univ, i:coq.univ.set, o:coq.univ.set. % [coq.univ.set.remove Elem A B] B is A \ {Elem} external pred coq.univ.set.remove i:univ, i:coq.univ.set, o:coq.univ.set. % [coq.univ.set.union A B X] X is A union B external pred coq.univ.set.union i:coq.univ.set, i:coq.univ.set, o:coq.univ.set. % [coq.univ.set.inter A B X] X is A intersection B external pred coq.univ.set.inter i:coq.univ.set, i:coq.univ.set, o:coq.univ.set. % [coq.univ.set.diff A B X] X is A \ B external pred coq.univ.set.diff i:coq.univ.set, i:coq.univ.set, o:coq.univ.set. % [coq.univ.set.equal A B] tests A and B for equality external pred coq.univ.set.equal i:coq.univ.set, i:coq.univ.set. % [coq.univ.set.subset A B] tests if A is a subset of B external pred coq.univ.set.subset i:coq.univ.set, i:coq.univ.set. % [coq.univ.set.elements M L] L is M transformed into list external pred coq.univ.set.elements i:coq.univ.set, o:list univ. % [coq.univ.set.cardinal M N] N is the number of elements of M external pred coq.univ.set.cardinal i:coq.univ.set, o:int. % CAVEAT: the type parameter of coq.univ.map must be a closed term kind coq.univ.map type -> type. % [coq.univ.map.empty M] The empty map external pred coq.univ.map.empty o:coq.univ.map A. % [coq.univ.map.mem S M] Checks if S is bound in M external pred coq.univ.map.mem i:univ, i:coq.univ.map A. % [coq.univ.map.add S V M M1] M1 is M where V is bound to S external pred coq.univ.map.add i:univ, i:A, i:coq.univ.map A, o:coq.univ.map A. % [coq.univ.map.remove S M M1] M1 is M where S is unbound external pred coq.univ.map.remove i:univ, i:coq.univ.map A, o:coq.univ.map A. % [coq.univ.map.find S M V] V is the binding of S in M external pred coq.univ.map.find i:univ, i:coq.univ.map A, o:A. % [coq.univ.map.bindings M L] L is M transformed into an associative list external pred coq.univ.map.bindings i:coq.univ.map A, o:list (pair univ A). kind coq.univ.variable.set type. % [coq.univ.variable.set.empty A] The empty set external pred coq.univ.variable.set.empty o:coq.univ.variable.set. % [coq.univ.variable.set.mem Elem A] Checks if Elem is in a external pred coq.univ.variable.set.mem i:univ.variable, i:coq.univ.variable.set. % [coq.univ.variable.set.add Elem A B] B is A union {Elem} external pred coq.univ.variable.set.add i:univ.variable, i:coq.univ.variable.set, o:coq.univ.variable.set. % [coq.univ.variable.set.remove Elem A B] B is A \ {Elem} external pred coq.univ.variable.set.remove i:univ.variable, i:coq.univ.variable.set, o:coq.univ.variable.set. % [coq.univ.variable.set.union A B X] X is A union B external pred coq.univ.variable.set.union i:coq.univ.variable.set, i:coq.univ.variable.set, o:coq.univ.variable.set. % [coq.univ.variable.set.inter A B X] X is A intersection B external pred coq.univ.variable.set.inter i:coq.univ.variable.set, i:coq.univ.variable.set, o:coq.univ.variable.set. % [coq.univ.variable.set.diff A B X] X is A \ B external pred coq.univ.variable.set.diff i:coq.univ.variable.set, i:coq.univ.variable.set, o:coq.univ.variable.set. % [coq.univ.variable.set.equal A B] tests A and B for equality external pred coq.univ.variable.set.equal i:coq.univ.variable.set, i:coq.univ.variable.set. % [coq.univ.variable.set.subset A B] tests if A is a subset of B external pred coq.univ.variable.set.subset i:coq.univ.variable.set, i:coq.univ.variable.set. % [coq.univ.variable.set.elements M L] L is M transformed into list external pred coq.univ.variable.set.elements i:coq.univ.variable.set, o:list univ.variable. % [coq.univ.variable.set.cardinal M N] N is the number of elements of M external pred coq.univ.variable.set.cardinal i:coq.univ.variable.set, o:int. % CAVEAT: the type parameter of coq.univ.variable.map must be a closed % term kind coq.univ.variable.map type -> type. % [coq.univ.variable.map.empty M] The empty map external pred coq.univ.variable.map.empty o:coq.univ.variable.map A. % [coq.univ.variable.map.mem S M] Checks if S is bound in M external pred coq.univ.variable.map.mem i:univ.variable, i:coq.univ.variable.map A. % [coq.univ.variable.map.add S V M M1] M1 is M where V is bound to S external pred coq.univ.variable.map.add i:univ.variable, i:A, i:coq.univ.variable.map A, o:coq.univ.variable.map A. % [coq.univ.variable.map.remove S M M1] M1 is M where S is unbound external pred coq.univ.variable.map.remove i:univ.variable, i:coq.univ.variable.map A, o:coq.univ.variable.map A. % [coq.univ.variable.map.find S M V] V is the binding of S in M external pred coq.univ.variable.map.find i:univ.variable, i:coq.univ.variable.map A, o:A. % [coq.univ.variable.map.bindings M L] L is M transformed into an % associative list external pred coq.univ.variable.map.bindings i:coq.univ.variable.map A, o:list (pair univ.variable A). % Coq box types for pretty printing: % - Vertical block: each break leads to a new line % - Horizontal block: no line breaking % - Horizontal-vertical block: same as Vertical block, except if this block % is small enough to fit on a single line in which case it is the same % as a Horizontal block % - Horizontal or Vertical block: breaks lead to new line only when % necessary to print the content of the block (the contents flow % inside the box) kind coq.pp.box type. type coq.pp.v int -> coq.pp.box. type coq.pp.h coq.pp.box. type coq.pp.hv int -> coq.pp.box. type coq.pp.hov int -> coq.pp.box. % Coq box model for pretty printing. Items: % - empty % - spc: a spacem, also a breaking hint % - str: a non breakable string % - brk L I: a breaking hint of a given length L contributing I spaces to % indentation when taken % - glue: puts things together % - box B: a box with automatic line breaking according to B % - comment: embedded \\n are turned into nl (see below) % - tag: ignored % - nl: break the line (should not be used) kind coq.pp type. type coq.pp.empty coq.pp. type coq.pp.spc coq.pp. type coq.pp.str string -> coq.pp. type coq.pp.brk int -> int -> coq.pp. type coq.pp.glue list coq.pp -> coq.pp. type coq.pp.box coq.pp.box -> list coq.pp -> coq.pp. type coq.pp.comment list string -> coq.pp. type coq.pp.tag string -> coq.pp -> coq.pp. type coq.pp.nl coq.pp. % [coq.pp->string B S] Prints a pp.t box expression B to a string S % Supported attributes: % - @ppwidth! N (default 80, max line length) external pred coq.pp->string i:coq.pp, o:string. coq-elpi-1.19.3/coq-elpi.opam000066400000000000000000000031251451177652200157200ustar00rootroot00000000000000opam-version: "2.0" name: "coq-elpi" version: "dev" maintainer: "Enrico Tassi " authors: [ "Enrico Tassi" ] license: "LGPL-2.1-or-later" homepage: "https://github.com/LPCIC/coq-elpi" bug-reports: "https://github.com/LPCIC/coq-elpi/issues" dev-repo: "git+https://github.com/LPCIC/coq-elpi" build: [ [ make "build" "COQBIN=%{bin}%/" "ELPIDIR=%{prefix}%/lib/elpi" "OCAMLWARN=" ] [ make "test" "COQBIN=%{bin}%/" "ELPIDIR=%{prefix}%/lib/elpi" ] {with-test} ] install: [ make "install" "COQBIN=%{bin}%/" "ELPIDIR=%{prefix}%/lib/elpi" ] depends: [ "stdlib-shims" "elpi" {>= "1.16.5" & < "1.18.0~"} "coq" {>= "8.18" & < "8.19~" } "dot-merlin-reader" {with-dev} "ocaml-lsp-server" {with-dev} ] tags: [ "category:Miscellaneous/Coq Extensions" "keyword:λProlog" "keyword:higher order abstract syntax" "logpath:elpi" ] synopsis: "Elpi extension language for Coq" description: """ Coq-elpi provides a Coq plugin that embeds ELPI. It also provides a way to embed Coq's terms into λProlog using the Higher-Order Abstract Syntax approach and a way to read terms back. In addition to that it exports to ELPI a set of Coq's primitives, e.g. printing a message, accessing the environment of theorems and data types, defining a new constant and so on. For convenience it also provides a quotation and anti-quotation for Coq's syntax in λProlog. E.g. `{{nat}}` is expanded to the type name of natural numbers, or `{{A -> B}}` to the representation of a product by unfolding the `->` notation. Finally it provides a way to define new vernacular commands and new tactics.""" coq-elpi-1.19.3/default.nix000066400000000000000000000006611451177652200154770ustar00rootroot00000000000000{ config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, update-nixpkgs ? false, ci-matrix ? false, override ? {}, ocaml-override ? {}, global-override ? {}, bundle ? null, job ? null, inNixShell ? null, src ? ./., }@args: let auto = fetchGit { url = "https://github.com/coq-community/coq-nix-toolbox.git"; ref = "master"; rev = import .nix/coq-nix-toolbox.nix; }; in import auto ({inherit src;} // args) coq-elpi-1.19.3/dune-project000066400000000000000000000000001451177652200156400ustar00rootroot00000000000000coq-elpi-1.19.3/elpi-builtin.elpi000066400000000000000000001141521451177652200166040ustar00rootroot00000000000000% Generated file, do not edit % == Core builtins ===================================== % -- Logic -- pred true. true. pred fail. pred false. external pred (=) o:A, o:A. % unification typeabbrev int (ctype "int"). typeabbrev string (ctype "string"). typeabbrev float (ctype "float"). pred (;) o:prop, o:prop. (A ; _) :- A. (_ ; B) :- B. type (:-) prop -> prop -> prop. type (:-) prop -> list prop -> prop. type (,) variadic prop prop. type uvar A. type (as) A -> A -> A. type (=>) prop -> prop -> prop. type (=>) list prop -> prop -> prop. % -- Control -- external pred !. % The cut operator pred not i:prop. not X :- X, !, fail. not _. % [declare_constraint C Key1 Key2...] declares C blocked % on Key1 Key2 ... (variables, or lists thereof). external type declare_constraint any -> any -> variadic any prop. external pred print_constraints. % prints all constraints % [halt ...] halts the program and print the terms external type halt variadic any prop. pred stop. stop :- halt. % -- Evaluation -- % [calc Expr Out] unifies Out with the value of Expr. It can be used in % tandem with spilling, eg [f {calc (N + 1)}] external pred calc i:A, o:A. pred (is) o:A, i:A. X is Y :- calc Y X. type (-) A -> A -> A. type (i-) int -> int -> int. type (r-) float -> float -> float. type (+) int -> int -> int. type (+) float -> float -> float. type (i+) int -> int -> int. type (r+) float -> float -> float. type (*) int -> int -> int. type (*) float -> float -> float. type (/) float -> float -> float. type (mod) int -> int -> int. type (div) int -> int -> int. type (^) string -> string -> string. type (~) int -> int. type (~) float -> float. type (i~) int -> int. type (r~) float -> float. type abs int -> int. type abs float -> float. type iabs int -> int. type rabs float -> float. type max int -> int -> int. type max float -> float -> float. type min int -> int -> int. type min float -> float -> float. type sqrt float -> float. type sin float -> float. type cos float -> float. type arctan float -> float. type ln float -> float. type int_to_real int -> float. type floor float -> int. type ceil float -> int. type truncate float -> int. type size string -> int. type chr int -> string. type rhc string -> int. type string_to_int string -> int. type int_to_string int -> string. type substring string -> int -> int -> string. type real_to_string float -> string. % -- Arithmetic tests -- % [lt_ X Y] checks if X < Y. Works for string, int and float external pred lt_ i:A, i:A. % [gt_ X Y] checks if X > Y. Works for string, int and float external pred gt_ i:A, i:A. % [le_ X Y] checks if X =< Y. Works for string, int and float external pred le_ i:A, i:A. % [ge_ X Y] checks if X >= Y. Works for string, int and float external pred ge_ i:A, i:A. type (<), (>), (=<), (>=) A -> A -> prop. X > Y :- gt_ X Y. X < Y :- lt_ X Y. X =< Y :- le_ X Y. X >= Y :- ge_ X Y. type (i<), (i>), (i=<), (i>=) int -> int -> prop. X i< Y :- lt_ X Y. X i> Y :- gt_ X Y. X i=< Y :- le_ X Y. X i>= Y :- ge_ X Y. type (r<), (r>), (r=<), (r>=) float -> float -> prop. X r< Y :- lt_ X Y. X r> Y :- gt_ X Y. X r=< Y :- le_ X Y. X r>= Y :- ge_ X Y. type (s<), (s>), (s=<), (s>=) string -> string -> prop. X s< Y :- lt_ X Y. X s> Y :- gt_ X Y. X s=< Y :- le_ X Y. X s>= Y :- ge_ X Y. % -- Standard data types (supported in the FFI) -- kind list type -> type. type (::) X -> list X -> list X. type ([]) list X. % Boolean values: tt and ff since true and false are predicates kind bool type. type tt bool. type ff bool. % Pair: the constructor is pr, since ',' is for conjunction kind pair type -> type -> type. type pr A -> B -> pair A B. pred fst i:pair A B, o:A. fst (pr A _) A. pred snd i:pair A B, o:B. snd (pr _ B) B. % The option type (aka Maybe) kind option type -> type. type none option A. type some A -> option A. % Result of a comparison kind cmp type. type eq cmp. type lt cmp. type gt cmp. % Used in builtin variants that return Coq's error rather than failing kind diagnostic type. type ok diagnostic. % Success type error string -> diagnostic. % Failure % == Elpi builtins ===================================== % [dprint ...] prints raw terms (debugging) external type dprint variadic any prop. % [print ...] prints terms external type print variadic any prop. % Deprecated, use trace.counter pred counter i:string, o:int. counter C N :- trace.counter C N. % [quote_syntax FileName QueryText QuotedProgram QuotedQuery] quotes the % program from FileName and the QueryText. See elpi-quoted_syntax.elpi for % the syntax tree external pred quote_syntax i:string, i:string, o:list A, o:A. typeabbrev loc (ctype "Loc.t"). % [loc.fields Loc File StartChar StopChar Line LineStartsAtChar] Decomposes % a loc into its fields external pred loc.fields i:loc, o:string, o:int, o:int, o:int, o:int. % == Regular Expressions ===================================== % [rex.match Rex Subject] checks if Subject matches Rex. Matching is based % on OCaml's Str library external pred rex.match i:string, i:string. % [rex.replace Rex Replacement Subject Out] Out is obtained by replacing all % occurrences of Rex with Replacement in Subject. See also OCaml's % Str.global_replace external pred rex.replace i:string, i:string, i:string, o:string. % [rex.split Rex Subject Out] Out is obtained by splitting Subject at all % occurrences of Rex. See also OCaml's Str.split external pred rex.split i:string, i:string, o:list string. % Deprecated, use rex.match pred rex_match i:string, i:string. rex_match Rx S :- rex.match Rx S. % Deprecated, use rex.replace pred rex_replace i:string, i:string, i:string, o:string. rex_replace Rx R S O :- rex.replace Rx R S O. % Deprecated, use rex.split pred rex_split i:string, i:string, o:list string. rex_split Rx S L :- rex.split Rx S L. % == Elpi nonlogical builtins ===================================== % Opaque ML data types kind ctyp type. type ctype string -> ctyp. % [var V ...] checks if the term V is a variable. When used with tree % arguments it relates an applied variable with its head and argument list. external type var any -> variadic any prop. % [prune V L] V is pruned to L (V is unified with a variable that only sees % the list of names L) external pred prune o:any, i:list any. % [distinct_names L] checks if L is a list of distinct names. If L is the % scope of a unification variable (its arguments, as per var predicate) then % distinct_names L checks that such variable is in the Miller pattern % fragment (L_\lambda) external pred distinct_names i:list any. % [same_var V1 V2] checks if the two terms V1 and V2 are the same variable, % ignoring the arguments of the variables external pred same_var i:A, i:A. % [same_term T1 T2] checks if the two terms T1 and T2 are syntactically % equal (no unification). It behaves differently than same_var since it % recursively compares the arguments of the variables external pred same_term i:A, i:A. % Infix notation for same_term pred (==) i:A, i:A. X == Y :- same_term X Y. % [cmp_term A B Cmp] Compares A and B. Only works if A and B are ground. external pred cmp_term i:any, i:any, o:cmp. % [name T ...] checks if T is a eigenvariable. When used with tree arguments % it relates an applied name with its head and argument list. external type name any -> variadic any prop. % [constant T ...] checks if T is a (global) constant. When used with tree % arguments it relates an applied constant with its head and argument list. external type constant any -> variadic any prop. external pred names % generates the list of eigenvariable o:list any. % list of eigenvariables in order of age (young first) external pred occurs % checks if the atom occurs in the term i:any, % an atom, that is a global constant or a bound name (aka eigenvariable) i:any. % a term % [closed_term T] unify T with a variable that has no eigenvariables in % scope external pred closed_term o:any. % [ground_term T] Checks if T contains unification variables external pred ground_term i:any. % [is_cdata T Ctype] checks if T is primitive of type Ctype, eg (ctype % "int") external pred is_cdata i:any, o:ctyp. pred primitive? i:A, i:string. primitive? X S :- is_cdata X (ctype S). % [new_int N] unifies N with a different int every time it is called. Values % of N are guaranteed to be incresing. external pred new_int o:int. % [findall_solution P L] finds all the solved instances of P and puts them % in L % in the order in which they are found. Instances can contain % eigenvariables % and unification variables. external pred findall_solutions i:prop, o:list prop. % Holds data across bracktracking; can only contain closed terms typeabbrev safe (ctype "safe"). % [new_safe Safe] creates a safe: a store that persists across backtracking external pred new_safe o:safe. % [stash_in_safe Safe Data] stores Data in the Safe external pred stash_in_safe i:safe, i:A. % [open_safe Safe Data] retrieves the Data stored in Safe external pred open_safe i:safe, o:list A. % [if C T E] picks the first success of C then runs T (never E). % if C has no success it runs E. pred if i:prop, i:prop, i:prop. if B T _ :- B, !, T. if _ _ E :- E. % [if2 C1 B1 C2 B2 E] like if but with 2 then branches (and one else branch). pred if2 i:prop, i:prop, i:prop, i:prop, i:prop. if2 G1 P1 _ _ _ :- G1, !, P1. if2 _ _ G2 P2 _ :- G2, !, P2. if2 _ _ _ _ E :- !, E. % [random.init Seed] Initialize OCaml's PRNG with the given Seed external pred random.init i:int. % [random.self_init] Initialize OCaml's PRNG with some seed external pred random.self_init . % [random.int Bound N] unifies N with a random int between 0 and Bound % (excluded) external pred random.int i:int, o:int. #line 0 "builtin_stdlib.elpi" % == stdlib ======================================================= % Conventions: % - all predicates declare a mode with some input arguments, unless... % - predicates whose name ends with R are relations (work in any direction, % that is all arguments are in output mode) % - predicates whose name ends with ! do contain a cut and generate only the % first result % - all errors given by this library end up calling fatal-error[-w-data], % override it in order to handle them differently % - all debug prints by this library end up calling debug-print, override it % in order to handle them differently namespace std { pred fatal-error i:string. :name "default-fatal-error" fatal-error Msg :- halt Msg. pred fatal-error-w-data i:string, i:A. :name "default-fatal-error-w-data" fatal-error-w-data Msg Data :- halt Msg ":" Data. pred debug-print i:string, i:A. :name "default-debug-print" debug-print Msg Data :- print Msg Data. % -- Errors, Debugging, Hacks -- pred ignore-failure! i:prop. ignore-failure! P :- P, !. ignore-failure! _. % [assert! C M] takes the first success of C or fails with message M pred assert! i:prop, i:string. assert! Cond Msg :- (Cond ; fatal-error-w-data Msg Cond), !. % [assert-ok! C M] like assert! but the last argument of the predicate must % be a diagnostic that is printed after M in case it is not ok pred assert-ok! i:(diagnostic -> prop), i:string. assert-ok! Cond Msg :- Cond Diagnostic, !, (Diagnostic = ok ; Diagnostic = error S, fatal-error-w-data Msg S), !. assert-ok! _ Msg :- fatal-error-w-data Msg "no diagnostic returned". % [spy P] traces the call to P, printing all success and the final failure pred spy i:prop. spy P :- trace.counter "run" NR, if (not(NR = 0)) (debug-print "run=" NR) true, debug-print "----<<---- enter: " P, P, debug-print "---->>---- exit: " P. spy P :- debug-print "---->>---- fail: " P, fail. % [spy! P] traces the first call to P without leaving a choice point pred spy! i:prop. spy! P :- trace.counter "run" NR, if (not(NR = 0)) (debug-print "run=" NR) true, debug-print "----<<---- enter: " P, P, debug-print "---->>---- exit: " P, !. spy! P :- debug-print "---->>---- fail: " P, fail. % to silence the type checker pred unsafe-cast o:A, o:B. unsafe-cast X X. % -- List processing -- pred length i:list A, o:int. length [_|L] N :- length L N1, N is N1 + 1. length [] 0. pred rev i:list A, o:list A. rev L RL :- rev.aux L [] RL. rev.aux [X|XS] ACC R :- rev.aux XS [X|ACC] R. rev.aux [] L L. pred last i:list A, o:A. last [] _ :- fatal-error "last on empty list". last [X] X :- !. last [_|XS] R :- last XS R. pred append i:list A, i:list A, o:list A. append [X|XS] L [X|L1] :- append XS L L1 . append [] L L . pred appendR o:list A, o:list A, o:list A. appendR [X|XS] L [X|L1] :- appendR XS L L1 . appendR [] L L . pred take i:int, i:list A, o:list A. take 0 _ [] :- !. take N [X|XS] [X|L] :- !, N1 is N - 1, take N1 XS L. take _ _ _ :- fatal-error "take run out of list items". pred take-last i:int, i:list A, o:list A. take-last N L R :- length L M, D is M - N, drop D L R. pred drop i:int, i:list A, o:list A. drop 0 L L :- !. drop N [_|XS] L :- !, N1 is N - 1, drop N1 XS L. drop _ _ _ :- fatal-error "drop run out of list items". pred drop-last i:int, i:list A, o:list A. drop-last N L R :- length L M, I is M - N, take I L R. pred split-at i:int, i:list A, o:list A, o:list A. split-at 0 L [] L :- !. split-at N [X|XS] [X|LN] LM :- !, N1 is N - 1, split-at N1 XS LN LM. split-at _ _ _ _ :- fatal-error "split-at run out of list items". pred fold i:list B, i:A, i:(B -> A -> A -> prop), o:A. fold [] A _ A. fold [X|XS] A F R :- F X A A1, fold XS A1 F R. pred fold2 i:list C, i:list B, i:A, i:(C -> B -> A -> A -> prop), o:A. fold2 [] [_|_] _ _ _ :- fatal-error "fold2 on lists of different length". fold2 [_|_] [] _ _ _ :- fatal-error "fold2 on lists of different length". fold2 [] [] A _ A. fold2 [X|XS] [Y|YS] A F R :- F X Y A A1, fold2 XS YS A1 F R. pred map i:list A, i:(A -> B -> prop), o:list B. map [] _ []. map [X|XS] F [Y|YS] :- F X Y, map XS F YS. pred map-i i:list A, i:(int -> A -> B -> prop), o:list B. map-i L F R :- map-i.aux L 0 F R. map-i.aux [] _ _ []. map-i.aux [X|XS] N F [Y|YS] :- F N X Y, M is N + 1, map-i.aux XS M F YS. pred map-filter i:list A, i:(A -> B -> prop), o:list B. map-filter [] _ []. map-filter [X|XS] F [Y|YS] :- F X Y, !, map-filter XS F YS. map-filter [_|XS] F YS :- map-filter XS F YS. :index(1 1) pred map2 i:list A, i:list B, i:(A -> B -> C -> prop), o:list C. map2 [] [_|_] _ _ :- fatal-error "map2 on lists of different length". map2 [_|_] [] _ _ :- fatal-error "map2 on lists of different length". map2 [] [] _ []. map2 [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, map2 XS YS F ZS. pred map2-filter i:list A, i:list B, i:(A -> B -> C -> prop), o:list C. map2-filter [] [_|_] _ _ :- fatal-error "map2-filter on lists of different length". map2-filter [_|_] [] _ _ :- fatal-error "map2-filter on lists of different length". map2-filter [] [] _ []. map2-filter [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, !, map2-filter XS YS F ZS. map2-filter [_|XS] [_|YS] F ZS :- map2-filter XS YS F ZS. pred map-ok i:list A, i:(A -> B -> diagnostic -> prop), o:list A, o:diagnostic. map-ok [X|L] P [Y|YS] S :- P X Y S0, if (S0 = ok) (map-ok L P YS S) (S = S0). map-ok [] _ [] ok. pred fold-map i:list A, i:B, i:(A -> B -> C -> B -> prop), o:list C, o:B. fold-map [] A _ [] A. fold-map [X|XS] A F [Y|YS] A2 :- F X A Y A1, fold-map XS A1 F YS A2. pred omap i:option A, i:(A -> B -> prop), o:option B. omap none _ none. omap (some X) F (some Y) :- F X Y. % [nth N L X] picks in X the N-th element of L (L must be of length > N) pred nth i:int, i:list A, o:A. nth 0 [X|_ ] R :- !, X = R. nth N [_|XS] R :- N > 0, !, N1 is N - 1, nth N1 XS R. nth N _ _ :- N < 0, !, fatal-error "nth got a negative index". nth _ _ _ :- fatal-error "nth run out of list items". % [lookup L K V] sees L as a map from K to V pred lookup i:list (pair A B), i:A, o:B. lookup [pr X Y|_] X Y. lookup [_|LS] X Y :- lookup LS X Y. % [lookup! L K V] sees L as a map from K to V, stops at the first binding pred lookup! i:list (pair A B), i:A, o:B. lookup! [pr X Y|_] X Y :- !. lookup! [_|LS] X Y :- lookup! LS X Y. % [mem! L X] succeeds once if X occurs inside L pred mem! i:list A, o:A. mem! [X|_] X :- !. mem! [_|L] X :- mem! L X. % [mem L X] succeeds every time if X occurs inside L pred mem i:list A, o:A. mem [X|_] X. mem [_|L] X :- mem L X. pred exists i:list A, i:(A -> prop). exists [X|_] P :- P X. exists [_|L] P :- exists L P. pred exists2 i:list A, i:list B, i:(A -> B -> prop). exists2 [] [_|_] _ :- fatal-error "exists2 on lists of different length". exists2 [_|_] [] _ :- fatal-error "exists2 on lists of different length". exists2 [X|_] [Y|_] P :- P X Y. exists2 [_|L] [_|M] P :- exists2 L M P. pred forall i:list A, i:(A -> prop). forall [] _. forall [X|L] P :- P X, forall L P. pred forall-ok i:list A, i:(A -> diagnostic -> prop), o:diagnostic. forall-ok [X|L] P S :- P X S0, if (S0 = ok) (forall-ok L P S) (S = S0). forall-ok [] _ ok. pred forall2 i:list A, i:list B, i:(A -> B -> prop). forall2 [] [_|_] _ :- fatal-error "forall2 on lists of different length". forall2 [_|_] [] _ :- fatal-error "forall2 on lists of different length". forall2 [X|XS] [Y|YS] P :- P X Y, forall2 XS YS P. forall2 [] [] _. pred filter i:list A, i:(A -> prop), o:list A. filter [] _ []. filter [X|L] P R :- if (P X) (R = X :: L1) (R = L1), filter L P L1. pred zip i:list A, i:list B, o:list (pair A B). zip [_|_] [] _ :- fatal-error "zip on lists of different length". zip [] [_|_] _ :- fatal-error "zip on lists of different length". zip [X|LX] [Y|LY] [pr X Y|LR] :- zip LX LY LR. zip [] [] []. pred unzip i:list (pair A B), o:list A, o:list B. unzip [] [] []. unzip [pr X Y|L] [X|LX] [Y|LY] :- unzip L LX LY. pred flatten i:list (list A), o:list A. flatten [X|LS] R :- flatten LS LS', append X LS' R. flatten [] []. pred null i:list A. null []. pred iota i:int, o:list int. iota N L :- iota.aux 0 N L. iota.aux X X [] :- !. iota.aux N X [N|R] :- M is N + 1, iota.aux M X R. % [intersperse X L R] R is [L0, X, ..., X, LN] :index(_ 1) pred intersperse i:A, i:list A, o:list A. intersperse _ [] []. intersperse _ [X] [X] :- !. intersperse Sep [X|XS] [X,Sep|YS] :- intersperse Sep XS YS. % -- Misc -- pred flip i:(A -> B -> prop), i:B, i:A. flip P X Y :- P Y X. pred time i:prop, o:float. time P T :- gettimeofday Before, P, gettimeofday After, T is After - Before. pred do! i:list prop. do! []. do! [P|PS] :- P, !, do! PS. :index(_ 1) pred do-ok! o:diagnostic, i:list (diagnostic -> prop). do-ok! ok []. do-ok! S [P|PS] :- P S0, !, if (S0 = ok) (do-ok! S PS) (S = S0). pred lift-ok i:prop, i:string, o:diagnostic. lift-ok P Msg R :- (P, R = ok; R = error Msg). pred spy-do! i:list prop. spy-do! L :- map L (x\y\y = spy x) L1, do! L1. pred while-ok-do! i:diagnostic, i:list (diagnostic -> prop), o:diagnostic. while-ok-do! (error _ as E) _ E. while-ok-do! ok [] ok. while-ok-do! ok [P|PS] R :- P C, !, while-ok-do! C PS R. pred any->string i:A, o:string. any->string X Y :- term_to_string X Y. pred max i:A, i:A, o:A. max N M N :- N >= M, !. max _ M M. % [findall P L] L is the list [P1,P2,P3..] where each Pi is a solution to P. pred findall i:prop, o:list prop. findall P L :- findall_solutions P L. } % [std.string.concat Separator Items Result] concatenates Items % interspersing Separator external pred std.string.concat i:string, i:list string, o:string. % CAVEAT: the type parameter of std.string.map must be a closed term kind std.string.map type -> type. % [std.string.map.empty M] The empty map external pred std.string.map.empty o:std.string.map A. % [std.string.map.mem S M] Checks if S is bound in M external pred std.string.map.mem i:string, i:std.string.map A. % [std.string.map.add S V M M1] M1 is M where V is bound to S external pred std.string.map.add i:string, i:A, i:std.string.map A, o:std.string.map A. % [std.string.map.remove S M M1] M1 is M where S is unbound external pred std.string.map.remove i:string, i:std.string.map A, o:std.string.map A. % [std.string.map.find S M V] V is the binding of S in M external pred std.string.map.find i:string, i:std.string.map A, o:A. % [std.string.map.bindings M L] L is M transformed into an associative list external pred std.string.map.bindings i:std.string.map A, o:list (pair string A). % CAVEAT: the type parameter of std.int.map must be a closed term kind std.int.map type -> type. % [std.int.map.empty M] The empty map external pred std.int.map.empty o:std.int.map A. % [std.int.map.mem S M] Checks if S is bound in M external pred std.int.map.mem i:int, i:std.int.map A. % [std.int.map.add S V M M1] M1 is M where V is bound to S external pred std.int.map.add i:int, i:A, i:std.int.map A, o:std.int.map A. % [std.int.map.remove S M M1] M1 is M where S is unbound external pred std.int.map.remove i:int, i:std.int.map A, o:std.int.map A. % [std.int.map.find S M V] V is the binding of S in M external pred std.int.map.find i:int, i:std.int.map A, o:A. % [std.int.map.bindings M L] L is M transformed into an associative list external pred std.int.map.bindings i:std.int.map A, o:list (pair int A). % CAVEAT: the type parameter of std.loc.map must be a closed term kind std.loc.map type -> type. % [std.loc.map.empty M] The empty map external pred std.loc.map.empty o:std.loc.map A. % [std.loc.map.mem S M] Checks if S is bound in M external pred std.loc.map.mem i:loc, i:std.loc.map A. % [std.loc.map.add S V M M1] M1 is M where V is bound to S external pred std.loc.map.add i:loc, i:A, i:std.loc.map A, o:std.loc.map A. % [std.loc.map.remove S M M1] M1 is M where S is unbound external pred std.loc.map.remove i:loc, i:std.loc.map A, o:std.loc.map A. % [std.loc.map.find S M V] V is the binding of S in M external pred std.loc.map.find i:loc, i:std.loc.map A, o:A. % [std.loc.map.bindings M L] L is M transformed into an associative list external pred std.loc.map.bindings i:std.loc.map A, o:list (pair loc A). kind std.string.set type. % [std.string.set.empty A] The empty set external pred std.string.set.empty o:std.string.set. % [std.string.set.mem Elem A] Checks if Elem is in a external pred std.string.set.mem i:string, i:std.string.set. % [std.string.set.add Elem A B] B is A union {Elem} external pred std.string.set.add i:string, i:std.string.set, o:std.string.set. % [std.string.set.remove Elem A B] B is A \ {Elem} external pred std.string.set.remove i:string, i:std.string.set, o:std.string.set. % [std.string.set.union A B X] X is A union B external pred std.string.set.union i:std.string.set, i:std.string.set, o:std.string.set. % [std.string.set.inter A B X] X is A intersection B external pred std.string.set.inter i:std.string.set, i:std.string.set, o:std.string.set. % [std.string.set.diff A B X] X is A \ B external pred std.string.set.diff i:std.string.set, i:std.string.set, o:std.string.set. % [std.string.set.equal A B] tests A and B for equality external pred std.string.set.equal i:std.string.set, i:std.string.set. % [std.string.set.subset A B] tests if A is a subset of B external pred std.string.set.subset i:std.string.set, i:std.string.set. % [std.string.set.elements M L] L is M transformed into list external pred std.string.set.elements i:std.string.set, o:list string. % [std.string.set.cardinal M N] N is the number of elements of M external pred std.string.set.cardinal i:std.string.set, o:int. kind std.int.set type. % [std.int.set.empty A] The empty set external pred std.int.set.empty o:std.int.set. % [std.int.set.mem Elem A] Checks if Elem is in a external pred std.int.set.mem i:int, i:std.int.set. % [std.int.set.add Elem A B] B is A union {Elem} external pred std.int.set.add i:int, i:std.int.set, o:std.int.set. % [std.int.set.remove Elem A B] B is A \ {Elem} external pred std.int.set.remove i:int, i:std.int.set, o:std.int.set. % [std.int.set.union A B X] X is A union B external pred std.int.set.union i:std.int.set, i:std.int.set, o:std.int.set. % [std.int.set.inter A B X] X is A intersection B external pred std.int.set.inter i:std.int.set, i:std.int.set, o:std.int.set. % [std.int.set.diff A B X] X is A \ B external pred std.int.set.diff i:std.int.set, i:std.int.set, o:std.int.set. % [std.int.set.equal A B] tests A and B for equality external pred std.int.set.equal i:std.int.set, i:std.int.set. % [std.int.set.subset A B] tests if A is a subset of B external pred std.int.set.subset i:std.int.set, i:std.int.set. % [std.int.set.elements M L] L is M transformed into list external pred std.int.set.elements i:std.int.set, o:list int. % [std.int.set.cardinal M N] N is the number of elements of M external pred std.int.set.cardinal i:std.int.set, o:int. kind std.loc.set type. % [std.loc.set.empty A] The empty set external pred std.loc.set.empty o:std.loc.set. % [std.loc.set.mem Elem A] Checks if Elem is in a external pred std.loc.set.mem i:loc, i:std.loc.set. % [std.loc.set.add Elem A B] B is A union {Elem} external pred std.loc.set.add i:loc, i:std.loc.set, o:std.loc.set. % [std.loc.set.remove Elem A B] B is A \ {Elem} external pred std.loc.set.remove i:loc, i:std.loc.set, o:std.loc.set. % [std.loc.set.union A B X] X is A union B external pred std.loc.set.union i:std.loc.set, i:std.loc.set, o:std.loc.set. % [std.loc.set.inter A B X] X is A intersection B external pred std.loc.set.inter i:std.loc.set, i:std.loc.set, o:std.loc.set. % [std.loc.set.diff A B X] X is A \ B external pred std.loc.set.diff i:std.loc.set, i:std.loc.set, o:std.loc.set. % [std.loc.set.equal A B] tests A and B for equality external pred std.loc.set.equal i:std.loc.set, i:std.loc.set. % [std.loc.set.subset A B] tests if A is a subset of B external pred std.loc.set.subset i:std.loc.set, i:std.loc.set. % [std.loc.set.elements M L] L is M transformed into list external pred std.loc.set.elements i:std.loc.set, o:list loc. % [std.loc.set.cardinal M N] N is the number of elements of M external pred std.loc.set.cardinal i:std.loc.set, o:int. #line 0 "builtin_map.elpi" kind std.map type -> type -> type. type std.map std.map.private.map K V -> (K -> K -> cmp -> prop) -> std.map K V. namespace std.map { % [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn pred make i:(K -> K -> cmp -> prop), o:std.map K V. make Cmp (std.map private.empty Cmp). % [find K M V] looks in M for the value V associated to K pred find i:K, i:std.map K V, o:V. find K (std.map M Cmp) V :- private.find M Cmp K V. % [add K V M M1] M1 is M where K is bound to V pred add i:K, i:V, i:std.map K V, o:std.map K V. add K V (std.map M Cmp) (std.map M1 Cmp) :- private.add M Cmp K V M1. % [remove K M M1] M1 is M where K is unbound pred remove i:K, i:std.map K V, o:std.map K V. remove K (std.map M Cmp) (std.map M1 Cmp) :- private.remove M Cmp K M1. % [bindings M L] L is the key-value pairs in increasing order pred bindings i:std.map K V, o:list (pair K V). bindings (std.map M _) L :- private.bindings M [] L. namespace private { % Taken from OCaml's map.ml kind map type -> type -> type. type empty map K V. type node map K V -> K -> V -> map K V -> int -> map K V. pred height i:map K V, o:int. height empty 0. height (node _ _ _ _ H) H. pred create i:map K V, i:K, i:V, i:map K V, o:map K V. create L K V R (node L K V R H) :- H is {std.max {height L} {height R}} + 1. pred bal i:map K V, i:K, i:V, i:map K V, o:map K V. bal L K V R T :- height L HL, height R HR, HL2 is HL + 2, HR2 is HR + 2, bal.aux HL HR HL2 HR2 L K V R T. bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :- HL > HR2, {height LL} >= {height LR}, !, create LL LV LD {create LR X D R} T. bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :- HL > HR2, !, create {create LL LV LD LRL} LRV LRD {create LRR X D R} T. bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :- HR > HL2, {height RR} >= {height RL}, !, create {create L X D RL} RV RD RR T. bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :- HR > HL2, !, create {create L X D RLL} RLV RLD {create RLR RV RD RR} T. bal.aux _ _ _ _ L K V R T :- create L K V R T. pred add i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V. add empty _ K V T :- create empty K V empty T. add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, add.aux E M Cmp X1 XD M1. add.aux eq (node L _ _ R H) _ X XD T :- T = node L X XD R H. add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T. add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T. pred find i:map K V, i:(K -> K -> cmp -> prop), i:K, o:V. find (node L K1 V1 R _) Cmp K V :- Cmp K K1 E, find.aux E Cmp L R V1 K V. find.aux eq _ _ _ V _ V. find.aux lt Cmp L _ _ K V :- find L Cmp K V. find.aux gt Cmp _ R _ K V :- find R Cmp K V. pred remove-min-binding i:map K V, o:map K V. remove-min-binding (node empty _ _ R _) R :- !. remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X. pred min-binding i:map K V, o:K, o:V. min-binding (node empty V D _ _) V D :- !. min-binding (node L _ _ _ _) V D :- min-binding L V D. pred merge i:map K V, i:map K V, o:map K V. merge empty X X :- !. merge X empty X :- !. merge M1 M2 R :- min-binding M2 X D, bal M1 X D {remove-min-binding M2} R. pred remove i:map K V, i:(K -> K -> cmp -> prop), i:K, o:map K V. remove empty _ _ empty :- !. remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M. remove.aux eq _ L R _ _ _ M :- merge L R M. remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M. remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M. pred bindings i:map K V, i:list (pair K V), o:list (pair K V). bindings empty X X. bindings (node L V D R _) X X1 :- bindings L [pr V D|{bindings R X}] X1. } % std.map.private } % std.map #line 0 "builtin_set.elpi" kind std.set type -> type. type std.set std.set.private.set E -> (E -> E -> cmp -> prop) -> std.set E. namespace std.set { % [make Eq Ltn M] builds an empty set M where keys are compared using Eq and Ltn pred make i:(E -> E -> cmp -> prop), o:std.set E. make Cmp (std.set private.empty Cmp). % [mem E M] looks if E is in M pred mem i:E, i:std.set E. mem E (std.set M Cmp):- private.mem M Cmp E. % [add E M M1] M1 is M + {E} pred add i:E, i:std.set E, o:std.set E. add E (std.set M Cmp) (std.set M1 Cmp) :- private.add M Cmp E M1. % [remove E M M1] M1 is M - {E} pred remove i:E, i:std.set E, o:std.set E. remove E (std.set M Cmp) (std.set M1 Cmp) :- private.remove M Cmp E M1. % [cardinal S N] N is the number of elements of S pred cardinal i:std.set E, o:int. cardinal (std.set M _) N :- private.cardinal M N. pred elements i:std.set E, o:list E. elements (std.set M _) L :- private.elements M [] L. namespace private { % Taken from OCaml's set.ml kind set type -> type. type empty set E. type node set E -> E -> set E -> int -> set E. pred height i:set E, o:int. height empty 0. height (node _ _ _ H) H. pred create i:set E, i:E, i:set E, o:set E. create L E R (node L E R H) :- H is {std.max {height L} {height R}} + 1. pred bal i:set E, i:E, i:set E, o:set E. bal L E R T :- height L HL, height R HR, HL2 is HL + 2, HR2 is HR + 2, bal.aux HL HR HL2 HR2 L E R T. bal.aux HL _ _ HR2 (node LL LV LR _) X R T :- HL > HR2, {height LL} >= {height LR}, !, create LL LV {create LR X R} T. bal.aux HL _ _ HR2 (node LL LV (node LRL LRV LRR _) _) X R T :- HL > HR2, !, create {create LL LV LRL} LRV {create LRR X R} T. bal.aux _ HR HL2 _ L X (node RL RV RR _) T :- HR > HL2, {height RR} >= {height RL}, !, create {create L X RL} RV RR T. bal.aux _ HR HL2 _ L X (node (node RLL RLV RLR _) RV RR _) T :- HR > HL2, !, create {create L X RLL} RLV {create RLR RV RR} T. bal.aux _ _ _ _ L E R T :- create L E R T. pred add i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E. add empty _ E T :- create empty E empty T. add (node L X R H) Cmp X1 S :- Cmp X1 X E, add.aux E Cmp L R X X1 H S. add.aux eq _ L R X _ H (node L X R H). add.aux lt Cmp L R E X _ T :- bal {add L Cmp X} E R T. add.aux gt Cmp L R E X _ T :- bal L E {add R Cmp X} T. pred mem i:set E, i:(E -> E -> cmp -> prop), i:E. mem (node L K R _) Cmp E :- Cmp E K O, mem.aux O Cmp L R E. mem.aux eq _ _ _ _. mem.aux lt Cmp L _ E :- mem L Cmp E. mem.aux gt Cmp _ R E :- mem R Cmp E. pred remove-min-binding i:set E, o:set E. remove-min-binding (node empty _ R _) R :- !. remove-min-binding (node L E R _) X :- bal {remove-min-binding L} E R X. pred min-binding i:set E, o:E. min-binding (node empty E _ _) E :- !. min-binding (node L _ _ _) E :- min-binding L E. pred merge i:set E, i:set E, o:set E. merge empty X X :- !. merge X empty X :- !. merge M1 M2 R :- min-binding M2 X, bal M1 X {remove-min-binding M2} R. pred remove i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E. remove empty _ _ empty. remove (node L E R _) Cmp X M :- Cmp X E O, remove.aux O Cmp L R E X M. remove.aux eq _ L R _ _ M :- merge L R M. remove.aux lt Cmp L R E X M :- bal {remove L Cmp X} E R M. remove.aux gt Cmp L R E X M :- bal L E {remove R Cmp X} M. pred cardinal i:set E, o:int. cardinal empty 0. cardinal (node L _ R _) N :- N is {cardinal L} + 1 + {cardinal R}. pred elements i:set E, i:list E, o:list E. elements empty X X. elements (node L E R _) Acc X :- elements L [E|{elements R Acc}] X. } % std.set.private } % std.set % == I/O builtins ===================================== % -- I/O -- typeabbrev in_stream (ctype "in_stream"). type std_in in_stream. typeabbrev out_stream (ctype "out_stream"). type std_out out_stream. type std_err out_stream. % [open_in FileName InStream] opens FileName for input external pred open_in i:string, o:in_stream. % [open_out FileName OutStream] opens FileName for output external pred open_out i:string, o:out_stream. % [open_append FileName OutStream] opens FileName for output in append mode external pred open_append i:string, o:out_stream. % [close_in InStream] closes input stream InStream external pred close_in i:in_stream. % [close_out OutStream] closes output stream OutStream external pred close_out i:out_stream. % [output OutStream Data] writes Data to OutStream external pred output i:out_stream, i:string. % [flush OutStream] flush all output not yet finalized to OutStream external pred flush i:out_stream. % [input InStream Bytes Data] reads Bytes from InStream external pred input i:in_stream, i:int, o:string. % [input_line InStream Line] reads a full line from InStream external pred input_line i:in_stream, o:string. % [eof InStream] checks if no more data can be read from InStream external pred eof i:in_stream. % -- System -- % [gettimeofday T] sets T to the number of seconds elapsed since 1/1/1970 external pred gettimeofday o:float. % [getenv VarName Value] Like Sys.getenv external pred getenv i:string, o:option string. % [system Command RetVal] executes Command and sets RetVal to the exit code external pred system i:string, o:int. % -- Unix -- % gathers the standard file descriptors or a process kind unix.process type. type unix.process out_stream -> in_stream -> in_stream -> unix.process. % [unix.process.open Executable Arguments Environment P Diagnostic] OCaml's % Unix.open_process_args_full. % Note that the first argument is the executable name (as in argv[0]). % If Executable is omitted it defaults to the first element of % Arguments. % Environment can be left unspecified, defaults to the current process % environment. % This API only works reliably since OCaml 4.12. external pred unix.process.open i:string, i:list string, i:list string, o:unix.process, o:diagnostic. % [unix.process.close P Diagnostic] OCaml's Unix.close_process_full external pred unix.process.close i:unix.process, o:diagnostic. % -- Debugging -- % [term_to_string T S] prints T to S external pred term_to_string i:any, o:string. % == Elpi runtime builtins ===================================== % [trace.counter Name Value] reads the Value of a trace point Name external pred trace.counter i:string, o:int. % [gc.get MinorHeapSize MajorHeapIncrement SpaceOverhead Verbose MaxOverhead % StackLimit AllocationPolicy WindowSize] Reads the current settings of the % garbage collector. See also OCaml's Gc.control type documentation. external pred gc.get o:int, o:int, o:int, o:int, o:int, o:int, o:int, o:int. % [gc.set MinorHeapSize MajorHeapIncrement SpaceOverhead Verbose MaxOverhead % StackLimit AllocationPolicy WindowSize] Writes the current settings of the % garbage collector. Any parameter left unspecificed (eg _) is not changed. % See also OCaml's Gc.control type documentation. external pred gc.set i:int, i:int, i:int, i:int, i:int, i:int, i:int, i:int. % [gc.minor] See OCaml's Gc.minor documentation. external pred gc.minor . % [gc.major] See OCaml's Gc.major documentation. external pred gc.major . % [gc.full] See OCaml's Gc.full_major documentation. external pred gc.full . % [gc.compact] See OCaml's Gc.compact documentation. external pred gc.compact . % [gc.stat MinorWords PromotedWords MajorWords MinorCollections % MajorCollections HeapWords HeapChunks LiveWords LiveBlocks FreeWords % FreeBlocks LargestFree Fragments Compactions TopHeapWords StackSize] See % OCaml's Gc.stat documentation. external pred gc.stat o:float, o:float, o:float, o:int, o:int, o:int, o:int, o:int, o:int, o:int, o:int, o:int, o:int, o:int, o:int, o:int. % [gc.quick-stat MinorWords PromotedWords MajorWords MinorCollections % MajorCollections HeapWords HeapChunks Compactions TopHeapWords StackSize] % See OCaml's Gc.quick_stat documentation. external pred gc.quick-stat o:float, o:float, o:float, o:int, o:int, o:int, o:int, o:int, o:int, o:int. % == Lambda Prolog builtins ===================================== % -- Extra I/O -- % [open_string DataIn InStream] opens DataIn as an input stream external pred open_string i:string, o:in_stream. % [lookahead InStream NextChar] peeks one byte from InStream external pred lookahead i:in_stream, o:string. % -- Hacks -- % [string_to_term S T] parses a term T from S external pred string_to_term i:string, o:any. % [readterm InStream T] reads T from InStream, ends with \n external pred readterm i:in_stream, o:any. pred printterm i:out_stream, i:A. printterm S T :- term_to_string T T1, output S T1. pred read o:A. read S :- flush std_out, input_line std_in X, string_to_term X S. coq-elpi-1.19.3/elpi/000077500000000000000000000000001451177652200142615ustar00rootroot00000000000000coq-elpi-1.19.3/elpi/README.md000066400000000000000000000015371451177652200155460ustar00rootroot00000000000000### coq-HOAS Documents how Coq terms are represented in Elpi. ### coq-lib Standard library of Coq specific utilities (in the coq. namespace). ### elpi-command-template Selects which files are accumulated in an `Elpi Command`. ### elpi-tactic-template Selects which files are accumulated in an `Elpi Tactic`. ### coq-elpi-checker Extends the standard type checker for Elpi programs so that it reports errors using Coq's I/O primitives. ### elpi-ltac Implementation of Ltac's like combinators in Elpi. ### elpi-reduction Implementation of reduction in Elpi. Main entry points are `whd` and `hd-beta`. ### coq-elaborator Uses the Coq type inference and unification algorithms in order to implement `of`, `unify-*` and `evar`. ### elpi-elaborator An elaborator completely written in Elpi (work in progress). It implements `of`, `unify-*` and `evar`. coq-elpi-1.19.3/elpi/coq-HOAS.elpi000066400000000000000000000475321451177652200164610ustar00rootroot00000000000000%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% coq-HOAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the low level data types linking Coq and elpi. % In particular: % - the data type for terms and the evar_map entries (a sequent) % - the entry points for commands and tactics (main and solve) % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry points % % Command and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry point for commands. Eg. "#[att=true] Elpi mycommand foo 3 (f x)." becomes % main [str "foo", int 3, trm (app[f,x])] % in a context where % attributes [attribute "att" (leaf "true")] % holds. The encoding of terms is described below. % See also the coq.parse-attributes utility. pred main i:list argument. pred usage. pred attributes o:list attribute. % Entry point for tactics. Eg. "elpi mytactic foo 3 (f x)." becomes % solve % Where [str "foo", int 3, trm (app[f,x])] is part of . % The encoding of goals is described below. % msolve is for tactics that operate on multiple goals (called via all: ). pred solve i:goal, o:list sealed-goal. pred msolve i:list sealed-goal, o:list sealed-goal. % The data type of arguments (for commands or tactics) kind argument type. type int int -> argument. % Eg. 1 -2. type str string -> argument. % Eg. x "y" z.w. or any Coq keyword/symbol type trm term -> argument. % Eg. (t). % Extra arguments for tactics type tac ltac1-tactic -> argument. % Extra arguments for commands. [Definition], [Axiom], [Record] and [Context] % take precedence over the [str] argument above (when not "quoted"). % % Eg. Record or Inductive type indt-decl indt-decl -> argument. % Eg. #[universes(polymorphic,...)] Record or Inductive type upoly-indt-decl indt-decl -> upoly-decl -> argument. type upoly-indt-decl indt-decl -> upoly-decl-cumul -> argument. % Eg. Definition or Axiom (when the body is none) type const-decl id -> option term -> arity -> argument. % Eg. #[universes(polymorphic,...)] Definition or Axiom type upoly-const-decl id -> option term -> arity -> upoly-decl -> argument. % Eg. Context A (b : A). type ctx-decl context-decl -> argument. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's terms % % Types of term formers % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- terms -------------------------------------------------------------------- kind term type. type sort sort -> term. % Prop, Type@{i} % constants: inductive types, inductive constructors, definitions type global gref -> term. type pglobal gref -> univ-instance -> term. % binders: to form functions, arities and local definitions type fun name -> term -> (term -> term) -> term. % fun x : t => type prod name -> term -> (term -> term) -> term. % forall x : t, type let name -> term -> term -> (term -> term) -> term. % let x : T := v in % other term formers: function application, pattern matching and recursion type app list term -> term. % app [hd|args] type match term -> term -> list term -> term. % match t p [branch]) type fix name -> int -> term -> (term -> term) -> term. % fix name rno ty bo type primitive primitive-value -> term. % NYI %type cofix name -> term -> (term -> term) -> term. % cofix name ty bo % Notes about (match Scrutinee TypingFunction Branches) when % Inductive i A : A -> nat -> Type := K : forall a : A, i A a 0 % and % Scrutinee be a term of type (i bool true 7) % % - TypingFunction has a very rigid shape that depends on i. Namely % as many lambdas as indexes plus one lambda for the inductive itself % where the value of the parameters are taken from the type of the scrutinee: % fun `a` (indt "bool") a\ % fun `n` (indt "nat) n\ % fun `i` (app[indt "i", indt "bool", a n) i\ .. % Such spine of fun cannot be omitted; else elpi cannot read the term back. % See also coq.bind-ind-arity-no-let in coq-lib.elpi, that builds such spine for you, % or the higher level api coq.build-match (same file) that also takes % care of breanches. % - Branches is a list of terms, the order is the canonical one (the order % of the constructors as they were declared). If the constructor has arguments % (excluding the parameters) then the corresponding term shall be a Coq % function. In this case % fun `x` (indt "bool") x\ .. % -- helpers ------------------------------------------------------------------ macro @cast T TY :- (let `cast` TY T x\x). % -- misc --------------------------------------------------------------------- % When one writes Constraint Handling Rules unification variables are "frozen", % i.e. represented by a fresh constant (the evar key) and a list of terms % (typically the variables in scope). kind evarkey type. type uvar evarkey -> list term -> term. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's evar_map % % Context and evar declaration % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % An evar_info (displayed as a Coq goal) is essentially a sequent: % % x : t % y := v : x % ---------- % p x y % % is coded as an Elpi query % % pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) % % where, by default, declare-evar creates a syntactic constraint as % % {x1 x2} : % decl x1 `x` , def x2 `y` x1 ?- % evar (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) /* suspended on RawEvar, Ev */ % % When the program is over, a remaining syntactic constraint like the one above % is read back and transformed into the corresponding evar_info. pred decl i:term, o:name, o:term. % Var Name Ty pred def i:term, o:name, o:term, o:term. % Var Name Ty Bo pred declare-evar i:list prop, i:term, i:term, i:term. % Ctx RawEvar Ty Evar :name "default-declare-evar" declare-evar Ctx RawEv Ty Ev :- declare_constraint (declare-evar Ctx RawEv Ty Ev) [RawEv]. % When a goal (evar _ _ _) is turned into a constraint the context is filtered % to only contain decl, def, pp. For now no handling rules for this set of % constraints other than one to remove a constraint pred rm-evar i:term, i:term. rm-evar (uvar as X) (uvar as Y):- !, declare_constraint (rm-evar X Y) [X,Y]. rm-evar _ _. constraint declare-evar evar def decl cache rm-evar { % Override the actual context rule \ (declare-evar Ctx RawEv Ty Ev) <=> (Ctx => evar RawEv Ty Ev). rule \ (rm-evar (uvar X _) (uvar Y _)) (evar (uvar X _) _ (uvar Y _)). rule \ (rm-evar (uvar X _) (uvar Y _)). } % The (evar R Ty E) predicate suspends when R and E are flexible, % and is solved otherwise. % The client may want to provide an alternative implementation of % the clause "default-assign-evar", for example to typechecks that the % term assigned to E has type Ty, or that the term assigned to R % elaborates to a term of type Ty that gets assigned to E. % In tactic mode, elpi/coq-elaborator.elpi wires things up that way. pred evar i:term, i:term, o:term. % Evar Ty RefinedSolution evar (uvar as X) T S :- var S _ VL, !, prune T VL, prune X VL, declare_constraint (evar X T S) [X, S]. :name "default-assign-evar" evar _ _ _. % volatile, only unresolved evars are considered as evars % To ease the creation of a context with decl and def % Eg. @pi-decl `x` x1\ @pi-def `y` y\ ... macro @pi-decl N T F :- pi x\ decl x N T => F x. macro @pi-def N T B F :- pi x\ def x N T B => cache x B_ => F x. macro @pi-parameter ID T F :- sigma N\ (coq.id->name ID N, pi x\ decl x N T => F x). macro @pi-inductive ID A F :- sigma N\ (coq.id->name ID N, coq.arity->term A T, pi x\ decl x N T => F x). % Sometimes it can be useful to pass to Coq a term with unification variables % representing "untyped holes" like an implicit argument _. In particular % a unification variable may exit the so called pattern fragment (applied % to distinct variables) and hence cannot be reliably mapped to Coq as an evar, % but can still be considered as an implicit argument. % By loading in the context get-option "HOAS:holes" tt one forces that % behavior. Here a convenience macro to be put on the LHS of => macro @holes! :- get-option "HOAS:holes" tt. % Similarly, some APIs take a term skeleton in input. In that case unification % variables are totally disregarded (not even mapped to Coq evars). They are % interpreted as the {{ lib:elpi.hole }} constant, which represents an implicit % argument. As a consenque these APIs don't modify the input term at all, but % rather return a copy. Note that if {{ lib:elpi.hole }} is used directly, then % it has to be applied to all variables in scope, since Coq erases variables % that are not used. For example using {{ forall x : nat, lib:elpi.hole }} as % a term skeleton is equivalent to {{ nat -> lib:elpi.hole }}, while % {{ forall x : nat, lib:elpi.hole x lib:elpi.hole more args }} puts x in % the scope of the hole (and passes to is more args). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's goals and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A Coq goal is essentially a sequent, like the evar_info above, but since it % has to be manipulated as first class Elpi data, it is represented in a slightly % different way. For example % % x : t % y := v : x % ---------- % g x y % % is represented by the following term of type sealed-goal % % nabla x1\ % nabla x2\ % seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % (Arguments x1 x2)) kind goal type. kind sealed-goal type. type nabla (term -> sealed-goal) -> sealed-goal. type seal goal -> sealed-goal. typeabbrev goal-ctx (list prop). type goal goal-ctx -> term -> term -> term -> list argument -> goal. % A sealed-goal closes with nabla the bound names of a % % (goal Ctx RawSolution Ty Solution Arguments) % % where Ctx is a list of decl or def and Solution is a unification variable % to be assigned to a term of type Ty in order to make progress. % RawSolution is used as a trigger: when a term is assigned to it, it is % elaborated against Ty and the resulting term is assigned to Solution. % % Arguments contains data attached to the goal, which lives in its context % and can be used by tactics to solve the goals. % A tactic (an elpi predicate which makes progress on a Coq goal) is % a predicate of type % sealed-goal -> list sealed-goal -> prop % % while the main entry point for a tactic written in Elpi is solve % which has type % goal -> list sealed-goal -> prop % % The utility (coq.ltac.open T G GL) postulates all the variables bounds % by nabla and loads the goal context before calling T on the unsealed % goal. The invocation of a tactic with arguments % 3 x "y" (h x) % on the previous goal results in the following Elpi query: % % (pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2)), % (coq.ltac.open solve % (nabla x1\ nabla x2\ seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % [int 3, str `x`, str`y`, trm (app[const `h`,x1])])) % NewGoals) % % If the goal sequent contains other evars, then a tactic invocation is % an Elpi query made of the conjunction of all the declare-evar queries % corresponding to these evars and the query corresponding to the goal % sequent. NewGoals can be assigned to a list of goals that should be % declared as open. Omitted goals are shelved. If NewGoals is not % assigned, then all unresolved evars become new goals, but the order % of such goals is not specified. % The file elpi-ltac.elpi provides a few combinators (other than coq.ltac.open) % in the tradition of LCF tacticals. The main difference is that the arguments % of custom written tactics must not be passed as predicate arguments but rather % put in the goal they receive. Indeed these arguments can contain terms, and % their bound variables cannot escape the seal. coq.ltac.set-goal-arguments % can be used to put an argument from the current goal context into another % goal. The coq.ltac.call utility can call Ltac1 code (written in Coq) and % pass arguments via this mechanism. % Last, since Elpi is alerady a logic programming language with primitive % support for unification variables, most of the work of a tactic can be % performed without using tacticals (which work on sealed goals) but rather % in the context of the original goal. The last step is typically to call % the refine utility with a term synthesized by the tactic or invoke some % Ltac1 code on that term (e.g. to call vm_compute, see also the example % on the reflexive tactic). % ----- Multi goals tactics. ---- % Coq provides goal selectors, such as all:, to pass to a tactic more than one % goal. In order to write such a tactic, Coq-Elpi provides another entry point % called msolve. To be precise, if there are two goals under focus, say and % , then all: elpi tac runs the following query % % msolve [,] NewGoals ; % note the disjunction % coq.ltac.all (coq.ltac.open solve) [,] NewGoals % % So, if msolve has no clause, Coq-Elpi will use solve on all the goals % independently. If msolve has a cluse, then it can manipulate the entire list % of sealed goals. Note that the argument is in both and but % it is interpreted in both contexts independently. If both goals have a proof % variable named "x" then passing (@eq_refl _ x) as equips both goals with % a (raw) proof that "x = x", no matter what their type is. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Declarations for Coq's API (environment read/write access, etc). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % tt = Yes, ff = No, unspecified = No (unspecified means "_" or a variable). typeabbrev opaque? bool. macro @opaque! :- tt. macro @transparent! :- ff. %%%%%%% Attributes to be passed to APIs as in @local! => coq.something %%%%%%%% macro @global! :- get-option "coq:locality" "global". macro @local! :- get-option "coq:locality" "local". macro @primitive! :- get-option "coq:primitive" tt. % primitive records macro @reversible! :- get-option "coq:reversible" tt. % coercions macro @no-tc! :- get-option "coq:no_tc" tt. % skip typeclass inference macro @uinstance! I :- get-option "coq:uinstance" I. % universe instance % declaration of universe polymorphic constants % The first list is the one of the unvierse variables being bound % The first boolean is tt if this list can be extended by Coq (or it has to % mention all universes actually used) % The second list if the one with the constaints amond where universes % The second boolean is tt if this list can be extended by Coq or it has to % mention all universe constraints actually required to type check the % declaration) macro @udecl! Vs LV Cs LC :- get-option "coq:udecl" (upoly-decl Vs LV Cs LC). macro @udecl-cumul! Vs LV Cs LC :- get-option "coq:udecl-cumul" (upoly-decl-cumul Vs LV Cs LC). macro @univpoly! :- @udecl! [] tt [] tt. macro @univpoly-cumul! :- @udecl-cumul! [] tt [] tt. macro @ppwidth! N :- get-option "coq:ppwidth" N. % printing width macro @ppall! :- get-option "coq:pp" "all". % printing all macro @ppmost! :- get-option "coq:pp" "most". % printing most of contents macro @pplevel! N :- get-option "coq:pplevel" N. % printing precedence (for parentheses) macro @keepunivs! :- get-option "coq:keepunivs" tt. % skeletons elaboration macro @dropunivs! :- get-option "coq:keepunivs" ff. % add-indt/add-const macro @using! S :- get-option "coq:using" S. % like the #[using=S] attribute macro @inline-at! N :- get-option "coq:inline" (coq.inline.at N). % like Inline(N) macro @inline! N :- get-option "coq:inline" coq.inline.default. % like macro @redflags! F :- get-option "coq:redflags" F. % for whd & co % both arguments are strings eg "8.12.0" "use foo instead" macro @deprecated! Since Msg :- get-option "coq:deprecated" (pr Since Msg). macro @ltacfail! N :- get-option "ltac:fail" N. % Declaration of inductive types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% kind indt-decl type. kind indc-decl type. kind record-decl type. % An arity is written, in Coq syntax, as: % (x : T1) .. (xn : Tn) : S1 -> ... -> Sn -> U % This syntax is used, for example, in the type of an inductive type or % in the type of constructors. We call the abstractions on the left of ":" % "parameters" while we call the type following the ":" (proper) arity. % Note: in some contexts, like the type of an inductive type constructor, % Coq makes no distinction between these two writings % (xn : Tn) : forall y1 : S1, ... and (xn : Tn) (y1 : S1) : ... % while Elpi is a bit more restrictive, since it understands user directives % such as the implicit status of an arguments (eg, using {} instead of () around % the binder), only on parameters. % Moreover parameters carry the name given by the user as an "id", while binders % in terms only carry it as a "name", an irrelevant pretty pringintg hint (see % also the HOAS of terms). A user command can hence only use the names of % parameters, and not the names of "forall" quantified variables in the arity. % % See also the arity->term predicate in coq-lib.elpi type parameter id -> implicit_kind -> term -> (term -> arity) -> arity. type arity term -> arity. type parameter id -> implicit_kind -> term -> (term -> indt-decl) -> indt-decl. type inductive id -> bool -> arity -> (term -> list indc-decl) -> indt-decl. % tt means inductive, ff coinductive type record id -> term -> id -> record-decl -> indt-decl. type constructor id -> arity -> indc-decl. type field field-attributes -> id -> term -> (term -> record-decl) -> record-decl. type end-record record-decl. % Example. % Remark that A is a regular parameter; y is a non-uniform parameter and t % also features an index of type bool. % % Inductive t (A : Type) | (y : nat) : bool -> Type := % | K1 (x : A) {n : nat} : S n = y -> t A n true -> t A y true % | K2 : t A y false % % is written % % (parameter "A" explicit {{ Type }} a\ % inductive "t" tt (parameter "y" explicit {{ nat }} _\ % arity {{ bool -> Type }}) % t\ % [ constructor "K1" % (parameter "y" explicit {{ nat }} y\ % (parameter "x" explicit a x\ % (parameter "n" maximal {{ nat }} n\ % arity {{ S lp:n = lp:y -> lp:t lp:n true -> lp:t lp:y true }}))) % , constructor "K2" % (parameter "y" explicit {{ nat }} y\ % arity {{ lp:t lp:y false }}) ]) % % Remark that the uniform parameters are not passed to occurrences of t, since % they never change, while non-uniform parameters are both abstracted % in each constructor type and passed as arguments to t. % % The coq.typecheck-indt-decl API can be used to fill in implicit arguments % an infer universe constraints in the declaration above (e.g. the hidden % argument of "=" in the arity of K1). % % Note: when and inductive type declaration is passed as an argument to an % Elpi command non uniform parameters must be separated from the uniform ones % with a | (a syntax introduced in Coq 8.12 and accepted by coq-elpi since % version 1.4, in Coq this separator is optional, but not in Elpi). % Context declaration (used as an argument to Elpi commands) kind context-decl type. % Eg. (x : T) or (x := B), body is optional, type may be a variable type context-item id -> implicit_kind -> term -> option term -> (term -> context-decl) -> context-decl. type context-end context-decl. typeabbrev field-attributes (list field-attribute). % retrocompatibility macro for Coq v8.10 macro @coercion! :- [coercion reversible]. coq-elpi-1.19.3/elpi/coq-elaborator.elpi000066400000000000000000000040171451177652200200500ustar00rootroot00000000000000/* Type inference and unification */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % This file does the plumbing to use Coq's elaborator :name "coq-assign-evar-raw" :before "default-assign-evar" evar X Ty R :- var R, !, of X Ty R. :name "coq-assign-evar-refined-hack-8-17-Prop" :before "default-assign-evar" evar X Ty R :- not(var R), same_term Ty {{ Prop }}, coq.version _ 8 17 _, !, hack-8-17.propagate-Prop-constraint-inward R, coq.typecheck R Ty ok, X = R. :name "coq-assign-evar-refined" :before "default-assign-evar" evar X Ty R :- not(var R), !, coq.typecheck R Ty ok, X = R. pred unify-eq i:term, i:term. unify-eq A B :- coq.unify-eq A B ok. pred unify-leq i:term, i:term. unify-leq A B :- coq.unify-leq A B ok. pred of i:term, o:term, o:term. of T Ty TR :- !, coq.elaborate-skeleton T Ty TR ok. namespace hack-8-17 { % This is a very partial fix for Coq 8.17 which "commits" holes to be in Type % too early. We propagate the Prop constraint by hand in some obvious cases. % Example (we add the inner ":Prop"): % Check (A -> _ -> _ : Prop) : Prop. % Starting with Coq 8.18 this is not necessary anymore pred propagate-Prop-constraint-inward i:term. propagate-Prop-constraint-inward {{ forall x : lp:Ty, lp:(F x) }} :- !, @pi-decl `x` Ty x\ propagate-Prop-constraint-inward (F x). propagate-Prop-constraint-inward {{ lp:A /\ lp:B }} :- !, propagate-Prop-constraint-inward A, propagate-Prop-constraint-inward B. propagate-Prop-constraint-inward {{ lp:A \/ lp:B }} :- !, propagate-Prop-constraint-inward A, propagate-Prop-constraint-inward B. propagate-Prop-constraint-inward {{ ~ lp:A }} :- !, propagate-Prop-constraint-inward A. propagate-Prop-constraint-inward (uvar as X) :- !, coq.typecheck X {{ Prop }} ok. propagate-Prop-constraint-inward (app[uvar|_] as X) :- !, coq.typecheck X {{ Prop }} ok. propagate-Prop-constraint-inward _. % no-op in all other cases } coq-elpi-1.19.3/elpi/coq-elpi-checker.elpi000066400000000000000000000016131451177652200202500ustar00rootroot00000000000000/* coq-elpi: Coq terms as the object language of elpi */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % redirect to Coq type checking messages :before "default-typechecking-error" error [] _ :- !. :before "default-typechecking-error" error [pr L M] tt :- !, coq.error L M. :before "default-typechecking-error" error Msgs tt :- !, coq.error "At least one of the following errors holds:" {error-concat Msgs}. pred error-concat i:list string, o:string. error-concat [] "\n". error-concat [pr L X] R :- error-concat XS Rest, term_to_string L LS, R is LS ^ " " ^ X. error-concat [pr L X|XS] R :- error-concat XS Rest, term_to_string L LS, R is LS ^ " " ^ X ^ "\n" ^ Rest. :before "default-typechecking-warning" warning L M :- !, coq.warning "elpi" "elpi.typecheck" L M. coq-elpi-1.19.3/elpi/coq-lib.elpi000066400000000000000000000771601451177652200164750ustar00rootroot00000000000000/* coq-elpi: Coq terms as the object language of elpi */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{fatal-error, fatal-error-w-data, debug-print, unsafe-cast}. shorten std.{rev, map, append, appendR, map2, forall-ok, take, do-ok!, lift-ok}. shorten std.{ omap, take-last, intersperse, map-ok, string.concat }. :before "default-fatal-error" fatal-error M :- !, stop M. :before "default-fatal-error-w-data" fatal-error-w-data Msg Data :- !, term_to_string Data DataS, M is Msg ^ ": " ^ DataS, stop M. :before "default-debug-print" debug-print M Data :- !, coq.say M Data. % HACK: elpi's stop has no argument type stop string -> prop. stop S :- get-option "ltac:fail" N, !, coq.ltac.fail N S. stop S :- coq.error S. % halt S %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Helpers % % Pure LP code that works with the data types and API above. % Named clauses are natural extension points, eg one can extend % subst-prod to perform reduction in order to expose a "prod" node. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Term surgery %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred coq.subst-prod i:list term, i:term, o:term. coq.subst-prod [] P P :- !. coq.subst-prod [X|XS] (prod _ _ F) P :- !, coq.subst-prod XS (F X) P. coq.subst-prod XS (let _ _ X F) P :- !, coq.subst-prod XS (F X) P. :name "subst-prod:fail" coq.subst-prod [_|_] T _ :- !, fatal-error-w-data "subst-prod: not a product" T. pred coq.subst-fun i:list term, i:term, o:term. coq.subst-fun [] T T :- !. coq.subst-fun [X|XS] (fun _ _ F) T :- !, coq.subst-fun XS (F X) T. coq.subst-fun XS (let _ _ X F) T :- !, coq.subst-fun XS (F X) T. :name "subst-fun:fail" coq.subst-fun [_|_] T _ :- !, fatal-error-w-data "subst-fun: not a lambda" T. pred coq.prod-R-fun o:term, o:term. coq.prod-R-fun (prod N T F) (fun N T R) :- !, pi x\ coq.prod-R-fun (F x) (R x). coq.prod-R-fun (let N T B F) (let N T B R) :- !, pi x\ coq.prod-R-fun (F x) (R x). coq.prod-R-fun X X. pred coq.prod->fun i:term, o:term. coq.prod->fun (prod N T F) (fun N T R) :- !, pi x\ coq.prod->fun (F x) (R x). coq.prod->fun (let N T B F) (let N T B R) :- !, pi x\ coq.prod->fun (F x) (R x). coq.prod->fun X X. pred coq.count-prods i:term, o:int. coq.count-prods (prod _ _ B) N :- !, (pi x\ coq.count-prods (B x) M), N is M + 1. coq.count-prods (let _ _ _ B) N :- !, (pi x\ coq.count-prods (B x) N). :name "count-prod:end" coq.count-prods _ 0 :- !. pred coq.mk-n-holes i:int, o:list A. coq.mk-n-holes 0 [] :- !. coq.mk-n-holes N [HOLE_|R] :- !, M is N - 1, coq.mk-n-holes M R. pred coq.safe-dest-app i:term, o:term, o:list term. coq.safe-dest-app (app [X|XS]) HD AllArgs :- !, coq.safe-dest-app X HD ARGS, append ARGS XS AllArgs. coq.safe-dest-app X X []. pred coq.mk-app i:term, i:list term, o:term. coq.mk-app HD [] HD :- !. coq.mk-app (app L) Args (app LArgs) :- !, append L Args LArgs. coq.mk-app (fun _ _ F) [A|Args] R :- !, coq.mk-app (F A) Args R. coq.mk-app (let _ _ A F) Args R :- !, coq.mk-app (F A) Args R. coq.mk-app HD Args (app [HD|Args]). pred coq.mk-app-uvar i:term, i:list term, o:term. coq.mk-app-uvar HD [] HD :- !. coq.mk-app-uvar (uvar as K) [A|Args] R :- !, unsafe-cast K K', coq.mk-app-uvar (K' A) Args R. % coq.mk-eta n Ty T: performs up to n (when >= 0) eta expasion of T % according to its type Ty. If n < 0 it makes as many step as % products in Ty. There be dragons if T has not type Ty. pred coq.mk-eta i:int, i:term, i:term, o:term. coq.mk-eta 0 _ B B :- !. coq.mk-eta N (prod Name Ty P) (fun _ _ F) (fun Name Ty F1) :- !, N1 is N - 1, pi x \ coq.mk-eta N1 (P x) (F x) (F1 x). coq.mk-eta N (prod Name Ty P) B (fun Name Ty B1) :- !, N1 is N - 1, pi x \ coq.mk-eta N1 (P x) {coq.mk-app B [x]} (B1 x). :name "mk-eta:end" coq.mk-eta _ _ B B :- !. pred coq.saturate i:term, i:term, o:term. coq.saturate Ty T O :- whd Ty [] (prod N Src Tgt) [], !, coq.mk-app T [Hole_] R, @pi-decl N Src x\ coq.saturate (Tgt x) R O. coq.saturate _ X X. % [copy A B] can be used to perform a replacement, eg % (copy (const "foo") (const "bar") :- !) => copy A B % traverses A replacing foo with bar. pred copy i:term, o:term. :name "copy:start" copy X Y :- name X, !, X = Y, !. % avoid loading "copy x x" at binders copy (global _ as C) C :- !. copy (pglobal _ _ as C) C :- !. copy (sort _ as C) C :- !. copy (fun N T F) (fun N T1 F1) :- !, copy T T1, pi x\ copy (F x) (F1 x). copy (let N T B F) (let N T1 B1 F1) :- !, copy T T1, copy B B1, pi x\ copy (F x) (F1 x). copy (prod N T F) (prod N T1 F1) :- !, copy T T1, (pi x\ copy (F x) (F1 x)). copy (app L) (app L1) :- !, map L copy L1. copy (fix N Rno Ty F) (fix N Rno Ty1 F1) :- !, copy Ty Ty1, pi x\ copy (F x) (F1 x). copy (match T Rty B) (match T1 Rty1 B1) :- !, copy T T1, copy Rty Rty1, map B copy B1. copy (primitive _ as C) C :- !. copy (uvar M L as X) W :- var X, !, map L copy L1, coq.mk-app-uvar M L1 W. % when used in CHR rules copy (uvar X L) (uvar X L1) :- map L copy L1. pred copy-ctx-item i:prop, o:prop. copy-ctx-item (decl X N T) (decl X1 N T1) :- copy X X1, copy T T1. copy-ctx-item (def X N T B) (def X1 N T1 B1) :- copy X X1, copy T T1, copy B B1. pred copy-arity i:arity, o:arity. copy-arity (parameter ID IMP T R) (parameter ID IMP T1 R1) :- copy T T1, pi x\ copy-arity (R x) (R1 x). copy-arity (arity T) (arity T1) :- copy T T1. pred copy-indt-decl i:indt-decl, o:indt-decl. copy-indt-decl (parameter ID I Ty D) (parameter ID I Ty1 D1) :- copy Ty Ty1, @pi-parameter ID Ty1 x\ copy-indt-decl (D x) (D1 x). copy-indt-decl (inductive ID CO A D) (inductive ID CO A1 D1) :- copy-arity A A1, @pi-inductive ID A1 i\ std.map (D i) copy-constructor (D1 i). copy-indt-decl (record ID T IDK F) (record ID T1 IDK F1) :- copy T T1, copy-fields F F1. pred copy-fields i:record-decl, o:record-decl. copy-fields end-record end-record. copy-fields (field Att ID T F) (field Att ID T1 F1) :- copy T T1, @pi-parameter ID T1 x\ copy-fields (F x) (F1 x). pred copy-constructor i:indc-decl, o:indc-decl. copy-constructor (constructor ID A) (constructor ID A1) :- copy-arity A A1. pred fold-map i:term, i:A, o:term, o:A. :name "fold-map:start" fold-map X A Y A :- name X, !, X = Y, !. % avoid loading "fold-map x A x A" at binders fold-map (global _ as C) A C A :- !. fold-map (pglobal _ _ as C) A C A :- !. fold-map (sort _ as C) A C A :- !. fold-map (fun N T F) A (fun N T1 F1) A2 :- !, fold-map T A T1 A1, pi x\ fold-map (F x) A1 (F1 x) A2. fold-map (let N T B F) A (let N T1 B1 F1) A3 :- !, fold-map T A T1 A1, fold-map B A1 B1 A2, pi x\ fold-map (F x) A2 (F1 x) A3. fold-map (prod N T F) A (prod N T1 F1) A2 :- !, fold-map T A T1 A1, (pi x\ fold-map (F x) A1 (F1 x) A2). fold-map (app L) A (app L1) A1 :- !, std.fold-map L A fold-map L1 A1. fold-map (fix N Rno Ty F) A (fix N Rno Ty1 F1) A2 :- !, fold-map Ty A Ty1 A1, pi x\ fold-map (F x) A1 (F1 x) A2. fold-map (match T Rty B) A (match T1 Rty1 B1) A3 :- !, fold-map T A T1 A1, fold-map Rty A1 Rty1 A2, std.fold-map B A2 fold-map B1 A3. fold-map (primitive _ as C) A C A :- !. fold-map (uvar M L as X) A W A1 :- var X, !, std.fold-map L A fold-map L1 A1, coq.mk-app-uvar M L1 W. % when used in CHR rules fold-map (uvar X L) A (uvar X L1) A1 :- std.fold-map L A fold-map L1 A1. pred fold-map-ctx-item i:prop, i:A, o:prop,o:A. fold-map-ctx-item (decl X N T) A (decl X1 N T1) A2 :- fold-map X A X1 A1, fold-map T A1 T1 A2. fold-map-ctx-item (def X N T B) A (def X1 N T1 B1) A3 :- fold-map X A X1 A1, fold-map T A1 T1 A2, fold-map B A2 B1 A3. pred fold-map-arity i:arity, i:A, o:arity, o:A. fold-map-arity (parameter ID IMP T R) A (parameter ID IMP T1 R1) A2 :- fold-map T A T1 A1, pi x\ fold-map-arity (R x) A1 (R1 x) A2. fold-map-arity (arity T) A (arity T1) A1 :- fold-map T A T1 A1. % Bridges the gap between the data types used to read/write inductives. % The arguments are the same of coq.env.indt plus an an extra one being % the output (of type indt-decl). pred coq.upoly-decl->attribute i:any, o:prop. coq.upoly-decl->attribute (upoly-decl A B C D) (@udecl! A B C D). coq.upoly-decl->attribute (upoly-decl-cumul A B C D) (@udecl-cumul! A B C D). pred coq.upoly-decl.complete-constraints i:upoly-decl, o:upoly-decl. coq.upoly-decl.complete-constraints (upoly-decl VS LV CS LC) (upoly-decl VS LV CS1 LC) :- std.do! [ std.map VS coq.univ.variable.constraints ExtraL, std.flatten ExtraL Extra, std.filter Extra (c\not(std.mem CS c)) New, std.append CS New CS1, ]. pred coq.upoly-decl-cumul.complete-constraints i:upoly-decl-cumul, o:upoly-decl-cumul. coq.upoly-decl-cumul.complete-constraints (upoly-decl-cumul VS LV CS LC) (upoly-decl-cumul VS LV CS1 LC) :- std.do! [ std.map VS coq.upoly-decl-cumul.complete-constraints.aux ExtraL, std.flatten ExtraL Extra, std.filter Extra (c\not(std.mem CS c)) New, std.append CS New CS1, ]. coq.upoly-decl-cumul.complete-constraints.aux (auto V) CS :- coq.univ.variable.constraints V CS. coq.upoly-decl-cumul.complete-constraints.aux (covariant V) CS :- coq.univ.variable.constraints V CS. coq.upoly-decl-cumul.complete-constraints.aux (invariant V) CS :- coq.univ.variable.constraints V CS. coq.upoly-decl-cumul.complete-constraints.aux (irrelevant V) CS :- coq.univ.variable.constraints V CS. pred coq.build-indt-decl i:(pair inductive id), i:bool, i:int, i:int, i:term, i:list (pair constructor id), i:list term, o:indt-decl. coq.build-indt-decl GR IsInd Pno UPno Arity Kns Ktys Decl :- coq.build-indt-decl-aux GR IsInd Pno UPno Arity Kns Ktys [] Decl. pred coq.build-indt-decl-aux i:pair inductive id, i:bool, i:int, i:int, i:term, i:list (pair constructor id), i:list term, i:list term, o:indt-decl. coq.build-indt-decl-aux (pr GR I) IsInd NUPno 0 Ty Kns KtysNu Params (inductive I IsInd Arity Ks) :- !, coq.term->arity Ty NUPno Arity, std.map KtysNu (k\coq.term->arity k NUPno) Ktys, rev Params ParamsR, (pi i\ Sub i = [ % we factor uniform parameters (pi x l\ copy (app[global (indt GR)|l]) (app[i|x]):- !, appendR ParamsR x l), (pi x l ui\ copy (app[pglobal (indt GR) ui|l]) (app[i|x]):- !, appendR ParamsR x l), (copy (global (indt GR)) i :- !), (pi ui\ copy (pglobal (indt GR) ui) i :- !) ]), pi i\ map2 Kns Ktys (gr_name\ ty\ res\ sigma tmp name\ Sub i => copy-arity ty tmp, gr_name = pr _ name, res = constructor name tmp) (Ks i). coq.build-indt-decl-aux GR IsInd Pno UPno (prod N S T) Kns Ktys Params (parameter NS explicit S Res) :- Pno > 0, UPno > 0, !, coq.name->id N NS, Pno1 is Pno - 1, UPno1 is UPno - 1, pi p\ map Ktys (coq.subst-prod [p]) (Ktys1 p), coq.build-indt-decl-aux GR IsInd Pno1 UPno1 (T p) Kns (Ktys1 p) [p|Params] (Res p). :name "coq.build-indt-decl-aux:fail" coq.build-indt-decl-aux _ _ _ _ _ _ _ _ _ :- !, fatal-error "coq.build-indt-decl-aux: invalid declaration". pred coq.rename-arity i:(id -> id -> prop), i:arity, o:arity. coq.rename-arity RP (parameter ID I TY In) (parameter ID1 I TY Out) :- RP ID ID1, @pi-parameter ID TY p\ coq.rename-arity RP (In p) (Out p). coq.rename-arity _ (arity T) (arity T). % [coq.rename-indt-decl RenameParam RenameIndType RenameIndConstr D D1] % can be used to rename all [id] part of an inductive type declaration pred coq.rename-indt-decl i:(id -> id -> prop), i:(id -> id -> prop), i:(id -> id -> prop), i:indt-decl, o:indt-decl. coq.rename-indt-decl RP RI RK (parameter ID I TY In) (parameter ID1 I TY Out) :- RP ID ID1, @pi-parameter ID TY p\ coq.rename-indt-decl RP RI RK (In p) (Out p). coq.rename-indt-decl RP RI RK (inductive ID Ind A In) (inductive ID1 Ind A1 Out) :- RI ID ID1, coq.rename-arity RP A A1, coq.id->name ID Name, coq.arity->term A TY, @pi-decl Name TY i\ std.map (In i) (coq.rename-indt-decl.aux RP RI RK) (Out i). coq.rename-indt-decl _ RI RK (record ID A KID F) (record ID1 A KID1 F) :- RI ID ID1, RK KID KID1. coq.rename-indt-decl.aux RP _ RK (constructor ID A) (constructor ID1 A1) :- RK ID ID1, coq.rename-arity RP A A1. pred coq.ensure-fresh-global-id i:string, o:string. coq.ensure-fresh-global-id Exp S :- Name is Exp, coq.env.fresh-global-id Name S, if (Name = S) true (coq.warning "elpi" "elpi.renamed" "Global name" Name "is taken, using" S "instead"). % Lifts coq.typecheck to inductive declarations pred coq.typecheck-indt-decl.heuristic-var-type i:term, o:diagnostic. coq.typecheck-indt-decl.heuristic-var-type (uvar _ _ as X) D :- !, coq.univ.new U, coq.unify-eq X (sort (typ U)) D. coq.typecheck-indt-decl.heuristic-var-type _ ok. pred coq.typecheck-indt-arity i:arity, o:term, o:int, o:diagnostic. coq.typecheck-indt-arity (parameter ID _ T D) (prod N T F) NU1 Diag :- do-ok! Diag [ coq.typecheck-ty T _, (d\ @pi-parameter ID T x\ coq.typecheck-indt-arity (D x) (F x) NU d), lift-ok (NU1 is NU + 1) "", lift-ok (coq.id->name ID N) "", ]. coq.typecheck-indt-arity (arity T) T 0 Diag :- do-ok! Diag [ coq.typecheck-ty T _, coq.typecheck-indt-decl.heuristic-var-type T, ]. pred coq.typecheck-indt-decl i:indt-decl, o:diagnostic. coq.typecheck-indt-decl (parameter ID _ T Decl) Diag :- do-ok! Diag [ coq.typecheck-ty T _, (d\ @pi-parameter ID T x\ coq.typecheck-indt-decl (Decl x) d), ]. coq.typecheck-indt-decl (inductive ID _ Arity KDecl) Diag :- do-ok! Diag [ coq.typecheck-indt-arity Arity A NUPNO, d\ @pi-parameter ID A i\ forall-ok (KDecl i) (coq.typecheck-indt-decl-c i A NUPNO) d ]. coq.typecheck-indt-decl (record ID A _IDK FDecl) Diag :- do-ok! Diag [ coq.typecheck-ty A _, d\ @pi-parameter ID A i\ do-ok! d [ lift-ok (coq.typecheck-indt-decl-field i FDecl (K i)) "", coq.typecheck-indt-decl-c i A 0 (constructor "fields" (arity (K i))) ] ]. pred coq.typecheck-indc-arity i:arity, i:int, o:term, o:sort, o:diagnostic. coq.typecheck-indc-arity A 0 T S Diag :- !, coq.arity->term A T, coq.typecheck-ty T S Diag. coq.typecheck-indc-arity (parameter ID _ T D) NUPNO (prod N T F) S Diag :- do-ok! Diag [ coq.typecheck-ty T _, lift-ok (NUPNO1 is NUPNO - 1) "", (d\ @pi-parameter ID T x\ coq.typecheck-indc-arity (D x) NUPNO1 (F x) S d), lift-ok (coq.id->name ID N) "", ]. pred coq.typecheck-indt-decl-c i:term, i:term, i:int, i:indc-decl, o:diagnostic. coq.typecheck-indt-decl-c I S NUPNO (constructor _ID Arity) Diag :- do-ok! Diag [ coq.typecheck-indc-arity Arity NUPNO T KS, coq.typecheck-indt-decl-c.unify-arrow-tgt I 0 S T, lift-ok (coq.arity->sort S IS) "", lift-ok (coq.sort.leq KS IS) "constructor universe too large" ]. pred coq.typecheck-indt-decl-c.unify-arrow-tgt i:term, i:int, i:term, i:term, o:diagnostic. coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (prod N S T) D :- @pi-decl N S x\ coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (T x) D. coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (let N S B T) D :- @pi-def N S B x\ coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (T x) D. coq.typecheck-indt-decl-c.unify-arrow-tgt I P A Concl D :- coq.count-prods A N, coq.mk-n-holes {calc (N + P)} Args, coq.mk-app I Args IArgs, coq.unify-eq Concl IArgs D. pred coq.typecheck-indt-decl-field i:term, i:record-decl, o:term. coq.typecheck-indt-decl-field I end-record I. coq.typecheck-indt-decl-field I (field _ ID T F) (prod N T F1) :- coq.id->name ID N, @pi-decl N T a\ coq.typecheck-indt-decl-field I (F a) (F1 a). % Lifts coq.elaborate-skeleton to inductive declarations pred coq.elaborate-indt-decl-skeleton i:indt-decl, o:indt-decl, o:diagnostic. coq.elaborate-indt-decl-skeleton (parameter ID Imp T Decl) (parameter ID Imp T1 Decl1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton T _ T1, (d\ @pi-parameter ID T1 x\ coq.elaborate-indt-decl-skeleton (Decl x) (Decl1 x) d), ]. coq.elaborate-indt-decl-skeleton (inductive ID I Arity KDecl) (inductive ID I Arity1 KDecl1) Diag :- do-ok! Diag [ coq.elaborate-arity-skeleton Arity _ Arity1, lift-ok (coq.arity->nparams Arity1 NUPNO) "", d\ coq.arity->term Arity1 A1, do-ok! d [ coq.typecheck-indt-decl.heuristic-var-type A1, d\ @pi-parameter ID A1 i\ map-ok (KDecl i) (coq.elaborate-indt-decl-skeleton-c i Arity1 NUPNO) (KDecl1 i) d ] ]. coq.elaborate-indt-decl-skeleton (record ID A IDK FDecl) (record ID A1 IDK FDecl1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton A _ A1, lift-ok (A1 = sort U) "record type is not a sort", d\ @pi-parameter ID A1 i\ coq.elaborate-indt-decl-skeleton-fields U FDecl FDecl1 d ]. pred coq.elaborate-indt-decl-skeleton-fields i:sort, i:record-decl, o:record-decl, o:diagnostic. coq.elaborate-indt-decl-skeleton-fields _ end-record end-record ok. coq.elaborate-indt-decl-skeleton-fields U (field Att ID A Fields) (field Att ID A1 Fields1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton A UA A1, lift-ok (coq.sort.leq UA U) "constructor universe too large", d\ @pi-parameter ID A1 p\ coq.elaborate-indt-decl-skeleton-fields U (Fields p) (Fields1 p) d ]. pred coq.elaborate-indt-decl-skeleton-c i:term, i:arity, i:int, i:indc-decl, o:indc-decl, o:diagnostic. coq.elaborate-indt-decl-skeleton-c I SA NUPNO (constructor ID Arity) (constructor ID Arity1) Diag :- do-ok! Diag [ coq.elaborate-arity-skeleton-nuparams Arity NUPNO KS Arity1, coq.typecheck-indt-decl-c.unify-arity I 0 SA Arity1, lift-ok (coq.arity->sort {coq.arity->term SA} IS) "", lift-ok (coq.sort.leq KS IS) "constructor universe too large" ]. pred coq.typecheck-indt-decl-c.unify-arity i:term, i:int, i:arity, i:arity, o:diagnostic. coq.typecheck-indt-decl-c.unify-arity I PNO (parameter _ _ T1 A) (parameter ID _ T C) D :- do-ok! D [ coq.unify-eq T1 T, lift-ok (PNO1 is PNO + 1) "", d\ @pi-parameter ID T p\ coq.typecheck-indt-decl-c.unify-arity I PNO1 (A p) (C p) d ]. coq.typecheck-indt-decl-c.unify-arity I PNO (arity A) (parameter ID _ T C) D :- @pi-parameter ID T p\ coq.typecheck-indt-decl-c.unify-arity I PNO (arity A) (C p) D. coq.typecheck-indt-decl-c.unify-arity I PNO (arity A) (arity C) D :- coq.typecheck-indt-decl-c.unify-arrow-tgt I PNO A C D. % Lifts coq.elaborate-skeleton to arity pred coq.elaborate-arity-skeleton i:arity, o:sort, o:arity, o:diagnostic. coq.elaborate-arity-skeleton (parameter ID Imp T A) U3 (parameter ID Imp T1 A1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton T U1 T1, (d\ @pi-parameter ID T1 i\ coq.elaborate-arity-skeleton (A i) U2 (A1 i) d), lift-ok (coq.sort.pts-triple U1 U2 U3) "coq.elaborate-arity-skeleton: should not happen", ]. coq.elaborate-arity-skeleton (arity A) U (arity A1) Diag :- coq.elaborate-ty-skeleton A U A1 Diag. pred coq.elaborate-arity-skeleton-nuparams i:arity, i:int, o:sort, o:arity, o:diagnostic. coq.elaborate-arity-skeleton-nuparams (parameter ID Imp T A) 0 U3 (parameter ID Imp T1 A1) Diag :- !, do-ok! Diag [ coq.elaborate-ty-skeleton T U1 T1, (d\ @pi-parameter ID T1 i\ coq.elaborate-arity-skeleton-nuparams (A i) 0 U2 (A1 i) d), lift-ok (coq.sort.pts-triple U1 U2 U3) "coq.elaborate-arity-skeleton-nuparams: should not happen", ]. coq.elaborate-arity-skeleton-nuparams (parameter ID Imp T A) N U (parameter ID Imp T1 A1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton T _ T1, lift-ok (M is N - 1) "", (d\ @pi-parameter ID T1 i\ coq.elaborate-arity-skeleton-nuparams (A i) M U (A1 i) d), ]. coq.elaborate-arity-skeleton-nuparams (arity A) _ U (arity A1) Diag :- coq.elaborate-ty-skeleton A U A1 Diag. % Converts an arity to a term pred coq.arity->term i:arity, o:term. coq.arity->term (parameter ID _ Ty Rest) (prod Name Ty R) :- coq.id->name ID Name, @pi-decl Name Ty x\ coq.arity->term (Rest x) (R x). coq.arity->term (arity A) A. pred coq.term->arity i:term, i:int, o:arity. coq.term->arity T 0 (arity T). coq.term->arity (prod Name S T) N (parameter ID explicit S R) :- M is N - 1, coq.name->id Name ID, @pi-decl Name S x\ coq.term->arity (T x) M (R x). % extracts the sort at the end of an arity pred coq.arity->sort i:term, o:sort. coq.arity->sort (prod N S X) Y :- !, @pi-decl N S x\ coq.arity->sort (X x) Y. coq.arity->sort (sort X) X :- !. :name "arity->sort:fail" coq.arity->sort T _ :- fatal-error-w-data "arity->sort: not a sort or prod" T. % Counts how many parameters are there pred coq.arity->nparams i:arity, o:int. coq.arity->nparams (parameter _ _ _ In) O :- pi x\ coq.arity->nparams (In x) O1, O is O1 + 1. coq.arity->nparams (arity _) 0. % Prints an arity pred coq.arity->pp o:arity, o:coq.pp. coq.arity->pp (parameter ID Imp T Arity) (coq.pp.glue Res) :- Res = [coq.pp.box (coq.pp.hv 2) [coq.pp.str A, coq.pp.str ID, coq.pp.str " :", coq.pp.spc,TPP,coq.pp.str B], coq.pp.spc, Rest], if2 (Imp = explicit) (A = "(", B = ")") (Imp = maximal) (A = "{", B = "}") (A = "[", B = "]"), coq.term->pp T TPP, @pi-parameter ID T x\ coq.arity->pp (Arity x) Rest. coq.arity->pp (arity T) (coq.pp.glue [coq.pp.str" : ",TPP]) :- coq.term->pp T TPP. % Get impargs setting from an arity pred coq.arity->implicits i:arity, o:list implicit_kind. coq.arity->implicits (parameter Id I Ty F) [I|Is] :- @pi-parameter Id Ty x\ coq.arity->implicits (F x) Is. coq.arity->implicits (arity _) []. % Get impargs setting from an indt-decl pred coq.indt-decl->implicits i:indt-decl, o:list implicit_kind, o:list (list implicit_kind). coq.indt-decl->implicits (parameter Id I Ty F) [I|Is] R :- @pi-parameter Id Ty x\ coq.indt-decl->implicits (F x) Is R1, std.map R1 (l\r\r = [I|l]) R. coq.indt-decl->implicits (record _ _ _ _) [] [[]]. coq.indt-decl->implicits (inductive Id _ A Ks) Is R :- coq.arity->implicits A Is, @pi-inductive Id A x\ std.map (Ks x) (c\i\sigma a\c = constructor _ a,coq.arity->implicits a i) R. % Check if some implicits are set pred coq.any-implicit? i:list implicit_kind. coq.any-implicit? L :- std.exists L (x\not(x = explicit)). % extract gref from terms that happen to have one pred coq.term->gref i:term, o:gref. coq.term->gref (global GR) GR :- !. coq.term->gref (pglobal GR _) GR :- !. coq.term->gref (app [Hd|_]) GR :- !, coq.term->gref Hd GR. coq.term->gref (let _ _ T x\x) GR :- !, coq.term->gref T GR. :name "term->gref:fail" coq.term->gref Term _ :- fatal-error-w-data "term->gref: input has no global reference" Term. pred coq.fresh-type o:term. coq.fresh-type (sort (typ U)) :- coq.univ.new U. pred coq.sort? i:term. coq.sort? (sort _). coq.sort? T :- whd1 T T1, coq.sort? T1. % Map the term under a spine of fun nodes pred coq.map-under-fun i:term, % InputTermUnderLams LamBoundVars TheirTypes Result i:(term -> list term -> list term -> term -> prop), o:term. coq.map-under-fun T F R :- map-under-fun.aux T [] [] F R. map-under-fun.aux (fun N T B) AccT AccTy F (fun N T R) :- !, @pi-decl N T x\ map-under-fun.aux (B x) [x|AccT] [T|AccTy] F (R x). map-under-fun.aux (let N T X B) AccT AccTy F (let N T X R) :- !, @pi-def N T X x\ map-under-fun.aux (B x) AccT AccTy F (R x). map-under-fun.aux End AccT AccTy F R :- F End {rev AccT} {rev AccTy} R. pred coq.iter-under-fun i:term, % InputTermUnderLams LamBoundVars TheirTypes i:(term -> list term -> list term -> prop). coq.iter-under-fun T F :- iter-under-fun.aux T [] [] F. iter-under-fun.aux (fun N T B) AccT AccTy F :- !, @pi-decl N T x\ iter-under-fun.aux (B x) [x|AccT] [T|AccTy] F. iter-under-fun.aux (let _ _ X B) AccT AccTy F :- !, iter-under-fun.aux (B X) AccT AccTy F. iter-under-fun.aux End AccT AccTy F :- F End {rev AccT} {rev AccTy}. % Build a match given the term and function to build the return type and the % branches pred coq.build-match i:term, % T, the term being matched i:term, % the type of T, expected to be an inductive, eventually applied % MkRty: IndSort LamBoundVars TheirTypes Result i:(term -> list term -> list term -> term -> prop), % MkBranch: Constructor ConstructorTyUnderLams LamBoundVars TheirTypes Result i:(term -> term -> list term -> list term -> term -> prop), o:term. % match T (.. MkRty) [ .. MkBranch K1, .. MkBranch K2, ..] coq.build-match T Tty RtyF BranchF (match T Rty Bs) :- whd Tty [] HD Args, if2 (HD = global (indt GR)) true (HD = pglobal (indt GR) I) true fail, @uinstance! I => coq.env.indt GR _ Lno _ Arity Kn Kt, take Lno Args LArgs, @uinstance! I => coq.mk-app {coq.env.global (indt GR)} LArgs IndtLArgs, % Rty coq.subst-prod LArgs Arity ArityArgs, coq.bind-ind-arity-no-let IndtLArgs ArityArgs RtyF Rty, % Bs map Kt (coq.subst-prod LArgs) KtArgs, map KtArgs hd-beta-zeta-reduce KtArgsNorm, map KtArgsNorm coq.prod->fun KtArgsLam, map Kn (k\r\ sigma K\ coq.env.global (indc k) K, coq.mk-app K LArgs r) KnArgs, map2 KnArgs KtArgsLam (k\t\coq.map-under-fun t (BranchF k)) Bs. % XXX the list of arguments are often needed in reverse order pred coq.bind-ind-arity % calls K under (fun Arity (x : Ity Arity) =>..) i:term, % the inductive type i:term, % the arity i:(term -> list term -> list term -> term -> prop), % Sort Vars Tys Out o:term. % bind-ind-arity.aux (prod N T B) (fun N T F) AccT AccTy IT K :- !, @pi-decl N T x\ bind-ind-arity.aux (B x) (F x) [x|AccT] [T|AccTy] IT K. bind-ind-arity.aux (let N T X B) (let N T X F) AccT AccTy IT K :- !, @pi-def N T X x\ bind-ind-arity.aux (B x) (F x) AccT AccTy IT K. bind-ind-arity.aux (sort _ as Sort) (fun `i` ITy F) AccT AccTy IT K :- rev AccT Vars, coq.mk-app IT Vars ITy, @pi-decl `i` ITy x\ K Sort {append Vars [x]} {rev [ITy|AccTy]} (F x). coq.bind-ind-arity IT Arity F R :- bind-ind-arity.aux Arity R [] [] IT F. % As above but let-ins are reduced pred coq.bind-ind-arity-no-let i:term, i:term, i:(term -> list term -> list term -> term -> prop), o:term. coq.bind-ind-arity-no-let IT Arity F R :- (pi N T X B F AccT AccTy IT K\ bind-ind-arity.aux (let N T X B) F AccT AccTy IT K :- !, bind-ind-arity.aux (B X) F AccT AccTy IT K) => bind-ind-arity.aux Arity R [] [] IT F. pred coq.bind-ind-parameters i:inductive, i:(term -> list term -> list term -> term -> prop), o:term. coq.bind-ind-parameters I K O :- coq.env.indt I _ _ N A _ _, coq.bind-ind-parameters.aux N A [] [] K O. coq.bind-ind-parameters.aux 0 Ty Vars Tys K O :- !, K Ty {std.rev Vars} {std.rev Tys} O. coq.bind-ind-parameters.aux I (prod N T F) Vs Ts K (fun N T G) :- I > 0, !, J is I - 1, @pi-decl N T x\ coq.bind-ind-parameters.aux J (F x) [x|Vs] [T|Ts] K (G x). coq.bind-ind-parameters.aux I (let N T B F) Vs Ts K (fun N T G) :- I > 0, !, J is I - 1, @pi-def N T B x\ coq.bind-ind-parameters.aux J (F x) [x|Vs] [T|Ts] K (G x). coq.bind-ind-parameters.aux I T Vs Ts K O :- I > 0, whd1 T T', !, coq.bind-ind-parameters.aux I T' Vs Ts K O. % coq.with-TC Class Instance->Clause Code: runs Code under a context augmented with % all instances for Class transformed by Instance->Clause. pred coq.with-TC i:term, i:(tc-instance -> prop -> prop), i:prop. coq.with-TC Class Instance->Clause Code :- coq.TC.db-for {coq.term->gref Class} Instances, map Instances Instance->Clause Hyps, !, Hyps => Code. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred coq.parse-attributes i:list attribute, i:list attribute-signature, o:list prop. % Coq attribute parser, eg [#[attribute=value] Command] % % Usage: % main _ :- % attributes A, % fetch % coq.parse-attributes A Spec Opts, % parse/validate % Opts => (mycode, get-option "foo" V, mycode). % use % % where [Opts] is a list of clauses [get-option StringName Value], where value % can have any type and [Spec] is a list of [attribute-sigmature]. % Example of an attribute signature: % [ % att "this" bool, % att "that.thing" int, % att "algebraic" (oneof ["foo" `-> foo-thing, "bar" `-> barbar]), % ] % % Env variable COQ_ELPI_ATTRIBUTES can be used to pass attributes to all % commands. These attributes names are prefixed by 'elpi.' and are of type % string. % % Eg. % COQ_ELPI_ATTRIBUTES=test=yes,str="some-string" coqc foo.v % results in commands in foo.v to receive % [ attribute "elpi.test" (leaf "yes") , % attribute "elpi.str" (leaf "some-string") | ...] % which are automatically accepted and give rise to % get-option "elpi.test" "yes" % get-option "elpi.str" "some-string" kind attribute-signature type. type att string -> attribute-type -> attribute-signature. type att-ignore-unknown attribute-signature. type supported-attribute attribute-signature -> prop. supported-attribute (att "elpi.loc" loc). supported-attribute (att Name string) :- rex_match "^elpi\\." Name. kind attribute-type type. type int attribute-type. type string attribute-type. type bool attribute-type. type oneof list attribute-mapping -> attribute-type. type attmap attribute-type. type loc attribute-type. kind attribute-mapping type. type (`->) string -> any -> attribute-mapping. pred coq.valid-str-attribute i:string, i:string, o:option any, o:diagnostic. coq.valid-str-attribute Name Value V Diag :- if (supported-attribute (att Name Type)) (coq.typecheck-attribute Name Type Value LPV Diag, V = some LPV) (if (supported-attribute att-ignore-unknown) (V = none, Diag = ok) (Diag = error {calc ( "Attribute " ^ Name ^ " is not supported")})). pred coq.valid-loc-attribute i:string, i:loc, o:diagnostic. coq.valid-loc-attribute Name Loc Diag :- if (supported-attribute (att Name loc)) (if (primitive? Loc "Loc.t") (Diag = ok) (Diag = error {calc ( "Attribute " ^ Name ^ " takes a loc, got " ^ {std.any->string Loc} ) } )) (if (supported-attribute att-ignore-unknown) (Diag = ok) (Diag = error {calc ( "Attribute " ^ Name ^ " is not supported")})). :index (_ 1 1) pred coq.typecheck-attribute i:string, o:attribute-type, i:string, o:any, o:diagnostic. coq.typecheck-attribute _ int Value V ok :- V is string_to_int Value, !. coq.typecheck-attribute N int Value _ (error Msg) :- Msg is "Attribute " ^ N ^ " takes an integer, got: " ^ Value. coq.typecheck-attribute _ string V V ok. coq.typecheck-attribute _ bool "true" tt ok. coq.typecheck-attribute _ bool "tt" tt ok. coq.typecheck-attribute _ bool "True" tt ok. coq.typecheck-attribute _ bool "on" tt ok. coq.typecheck-attribute _ bool "yes" tt ok. coq.typecheck-attribute _ bool "" tt ok. coq.typecheck-attribute _ bool "false" ff ok. coq.typecheck-attribute _ bool "False" ff ok. coq.typecheck-attribute _ bool "off" ff ok. coq.typecheck-attribute _ bool "ff" ff ok. coq.typecheck-attribute _ bool "no" ff ok. coq.typecheck-attribute N bool Value _ (error Msg) :- Msg is "Attribute " ^ N ^ " takes an boolean, got: " ^ Value. pred coq.is-one-of i:string, o:any, i:attribute-mapping. coq.is-one-of K V (K `-> V). coq.typecheck-attribute _ (oneof L) K V ok :- std.exists L (coq.is-one-of K V), !. coq.typecheck-attribute N (oneof L) K _ (error Msg) :- std.map L (x\r\ sigma tmp\ x = r `-> tmp) S, std.fold S "" (s\ a\ calc (a ^ " " ^ s)) OneOf, Msg is "Attribute " ^ N ^ " takes one of " ^ OneOf ^ ", got: " ^ K. coq.parse-attributes L S O :- std.map S (x\r\ r = supported-attribute x) CS, CS => parse-attributes.aux L "" O, !. parse-attributes.aux [] _ []. parse-attributes.aux [attribute S (node L)|AS] Prefix R :- if (Prefix = "") (PS = S) (PS is Prefix ^ "." ^ S), supported-attribute (att PS attmap), !, parse-attributes.aux AS Prefix R1, (pi x\ supported-attribute (att x string) :- !) => parse-attributes.aux L "" Map, std.append R1 [get-option PS Map] R. parse-attributes.aux [attribute S (node L)|AS] Prefix R :- !, parse-attributes.aux AS Prefix R1, if (Prefix = "") (PS = S) (PS is Prefix ^ "." ^ S), parse-attributes.aux L PS R2, std.append R1 R2 R. parse-attributes.aux [attribute S (leaf-str V)|AS] Prefix CLS :- !, if (Prefix = "") (PS = S) (PS is Prefix ^ "." ^ S), coq.valid-str-attribute PS V V1 Diag, if (Diag = error Msg) (coq.error Msg) true, if (V1 = some Val) (CLS = [get-option PS Val|R]) (CLS = R), % ignored parse-attributes.aux AS Prefix R. parse-attributes.aux [attribute S (leaf-loc V)|AS] Prefix CLS :- !, if (Prefix = "") (PS = S) (PS is Prefix ^ "." ^ S), coq.valid-loc-attribute PS V Diag, if (Diag = error Msg) (coq.error Msg) true, CLS = [get-option PS V|R], parse-attributes.aux AS Prefix R. coq-elpi-1.19.3/elpi/elpi-command-template.elpi000066400000000000000000000006421451177652200213140ustar00rootroot00000000000000/* Loaded when Elpi Command is used */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ accumulate elpi/coq-lib. % basic term manipulation routines accumulate elpi/elpi-reduction. % whd, hd-beta, ... accumulate elpi/elpi-ltac. % refine, or, thenl, ... coq-elpi-1.19.3/elpi/elpi-ltac.elpi000066400000000000000000000114201451177652200170040ustar00rootroot00000000000000/* elpi-ltac: building blocks for tactics */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ typeabbrev tactic (sealed-goal -> (list sealed-goal -> prop)). typeabbrev open-tactic (goal -> (list sealed-goal -> prop)). % The one tactic ------------------------------------------------------------ pred refine i:term, i:goal, o:list sealed-goal. refine T G GS :- refine.elaborate T G GS. pred refine.elaborate i:term, i:goal, o:list sealed-goal. refine.elaborate T (goal _ RawEv Ty Ev _) GS :- rm-evar RawEv Ev, @keepunivs! => coq.elaborate-skeleton T Ty TR ok, coq.ltac.collect-goals TR GS _, RawEv = T, Ev = TR. pred refine.typecheck i:term, i:goal, o:list sealed-goal. refine.typecheck T (goal _ RawEv Ty Ev _) GS :- rm-evar RawEv Ev, coq.typecheck T Ty ok, coq.ltac.collect-goals T GS _, RawEv = T, Ev = T. pred refine.no_check i:term, i:goal, o:list sealed-goal. refine.no_check T (goal _ RawEv _ Ev _) GS :- rm-evar RawEv Ev, coq.ltac.collect-goals T GS _, RawEv = T, Ev = T. % calling other tactics, with arguments --------------------------------------- pred coq.ltac i:string, i:sealed-goal, o:list sealed-goal. coq.ltac Tac G GS :- coq.ltac.open (coq.ltac.call-ltac1 Tac) G GS. namespace coq.ltac { pred call i:string, i:list argument, i:goal, o:list sealed-goal. call Tac Args G GS :- set-goal-arguments Args G (seal G) (seal G1), coq.ltac.call-ltac1 Tac G1 GS. pred set-goal-arguments i:list argument, i:goal, i:sealed-goal, o:sealed-goal. set-goal-arguments A G (nabla SG) (nabla R) :- pi x\ set-goal-arguments A G (SG x) (R x). set-goal-arguments A (goal Ctx1 _ _ _ _) (seal (goal Ctx2 REv2 Ty2 Ev2 _)) (seal (goal Ctx2 REv2 Ty2 Ev2 I)) :- same_term Ctx1 Ctx2, !, A = I. set-goal-arguments A (goal Ctx1 _ _ _ _) (seal (goal Ctx2 REv2 Ty2 Ev2 _)) (seal (goal Ctx2 REv2 Ty2 Ev2 I)) :- std.map A (private.move-goal-argument Ctx1 Ctx2) I. % Tacticals ---------------------------------------------------------------- pred try i:tactic, i:sealed-goal, o:list sealed-goal. try T G GS :- T G GS. try _ G [G]. :index(_ 1) pred all i:tactic, i:list sealed-goal, o:list sealed-goal. all T [G|Gs] O :- T G O1, all T Gs O2, std.append O1 O2 O. all _ [] []. pred thenl i:list tactic, i:sealed-goal, o:list sealed-goal. thenl [] G [G]. thenl [T|Ts] G GS :- T G NG, all (thenl Ts) NG GS. pred repeat i:tactic, i:sealed-goal, o:list sealed-goal. repeat T G GS :- T G GS1, all (repeat T) GS1 GS. repeat _ G [G]. pred repeat! i:tactic, i:sealed-goal, o:list sealed-goal. repeat! T G GS :- T G GS1, !, all (repeat T) GS1 GS. repeat! _ G [G]. pred or i:list tactic, i:sealed-goal, o:list sealed-goal. or TL G GS :- std.exists TL (t\ t G GS). :index(_ 1) pred open i:open-tactic, i:sealed-goal, o:list sealed-goal. open T (nabla G) O :- (pi x\ open T (G x) (NG x)), private.distribute-nabla NG O. open _ (seal (goal _ _ _ Solution _)) [] :- not (var Solution), !. % solved by side effect open T (seal (goal Ctx _ _ _ _ as G)) O :- std.filter Ctx private.not-already-assumed Ctx1, Ctx1 => T G O, if (var O) (G = goal _ _ _ P _, coq.ltac.collect-goals P O1 O2, std.append O1 O2 O) true. % helper code --------------------------------------------------------------- namespace private { :index(_ _ 1) pred move-goal-argument i:list prop, i:list prop, i:argument, o:argument. move-goal-argument _ _ (int _ as A) A. move-goal-argument _ _ (str _ as A) A. move-goal-argument _ _ (tac _) _ :- coq.error "NIY: move tactic goal argument to another context". move-goal-argument C D (trm T) (trm T1) :- std.rev C Cr, std.rev D Dr, std.assert! (move-term Cr Dr T T1) "cannot move goal argument to the right context", !. :index(2) pred move-term i:list prop, i:list prop, i:term, o:term. move-term [] _ T T1 :- copy T T1. move-term [decl X _ TX|C1] [decl Y _ TY|C2] T T1 :- std.do! [ copy TX TX1, same_term TX1 TY ], !, copy X Y => move-term C1 C2 T T1. move-term [def X _ TX BX|C1] [def Y _ TY BY|C2] T T1 :- std.do! [ copy TX TX1, same_term TX1 TY, copy BX BX1, same_term BX1 BY ], !, copy X Y => move-term C1 C2 T T1. move-term [decl X _ _|C1] C2 T T1 :- not(occurs X T), !, move-term C1 C2 T T1. move-term [def X _ _ _|C1] C2 T T1 :- not(occurs X T), !, move-term C1 C2 T T1. move-term C1 [_|C2] T T1 :- move-term C1 C2 T T1. pred distribute-nabla i:(term -> list sealed-goal), o:list sealed-goal. distribute-nabla (_\ []) []. distribute-nabla (x\ [X x| XS x]) [nabla X|R] :- (pi x\ occurs x (X x)), !, distribute-nabla XS R. distribute-nabla (x\ [X| XS x]) [X|R] :- distribute-nabla XS R. pred not-already-assumed i:prop. not-already-assumed (decl X _ _Ty) :- not(decl X _ _ ; def X _ _ _). not-already-assumed (def X _ _Ty _Bo) :- not(decl X _ _ ; def X _ _ _). }}coq-elpi-1.19.3/elpi/elpi-reduction.elpi000066400000000000000000000102161451177652200200570ustar00rootroot00000000000000/* Reduction (whd, hd-beta, ...) */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % Entry points typeabbrev stack (list term). pred hd-beta i:term, i:stack, o:term, o:stack. pred hd-beta-zeta i:term, i:stack, o:term, o:stack. pred hd-beta-zeta-reduce i:term, o:term. pred whd i:term, i:stack, o:term, o:stack. pred whd-indc i:term, o:constructor, o:stack. pred unwind i:term, i:stack, o:term. pred whd1 i:term, o:term. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% shorten std.{append, nth, drop}. % indirection, to be used if we add to the stack "match" frames unwind T A R :- if (var T) (coq.mk-app-uvar T A R) (coq.mk-app T A R). pred nth-stack i:int, i:stack, o:stack, o:term, o:stack. nth-stack 0 [X|XS] [] X XS :- !. nth-stack N [X|XS] [X|Before] At After :- M is N - 1, nth-stack M XS Before At After. % whd beta-iota-delta-zeta, main code whd (app [Hd|Args]) C X XC :- !, whd Hd {append Args C} X XC. whd (fun _ _ _ as X) [] X [] :- !. whd (fun N T F) [B|C] X XC :- !, (pi x\ def x N T B => cache x BN_ => whd (F x) C (F1 x) (C1 x)), X = F1 B, XC = C1 B. whd (let N T B F) C X XC :- !, (pi x\ def x N T B => cache x BN_ => whd (F x) C (F1 x) (C1 x)), X = F1 B, XC = C1 B. whd (global (const GR)) C X XC :- unfold GR none C D DC, !, whd D DC X XC. whd (pglobal (const GR) I) C X XC :- unfold GR (some I) C D DC, !, whd D DC X XC. whd (primitive (proj _ N)) [A|C] X XC :- whd-indc A _ KA, !, whd {proj-red KA N C} X XC. whd (global (const GR) as HD) C X XC :- coq.env.primitive? GR, !, unwind HD C Orig, coq.reduction.lazy.whd_all Orig R, if (same_term Orig R) (X = HD, XC = C) (whd R [] X XC). whd (match A _ L) C X XC :- whd-indc A GR KA, !, whd {match-red GR KA L C} X XC. whd (fix _ N _ F as Fix) C X XC :- nth-stack N C LA A RA, whd-indc A GR KA, !, whd {fix-red F Fix LA GR KA RA} X XC. whd N C X XC :- name N, def N _ _ V, !, cache-whd N VN V, whd VN C X XC. whd X C X C. % assert A reduces to a constructor whd-indc A GR KA :- whd A [] VA C, !, VA = global (indc GR), KA = C. % [whd1 T R] asserts progress was made in reducing T to R. whd1 T R :- whd T [] HD ARGS, unwind HD ARGS R, not(same_term T R). % iota step pred match-red i:constructor, i:list term, i:list term, i:stack, o:term, o:stack. match-red GR KArgs BL C X XC :- coq.env.indc GR Lno _ Ki _, drop Lno KArgs Args, nth Ki BL Bi, hd-beta {coq.mk-app Bi Args} C X XC. pred proj-red i:list term, i:int, i:stack, o:term, o:stack. proj-red Args FieldNo C V C :- nth FieldNo Args V. % iota step pred fix-red i:(term -> term), i:term, i:list term, i:constructor, i:list term, i:list term, o:term, o:stack. fix-red F Fix LA GR KA RA X XC :- append LA [{coq.mk-app (global (indc GR)) KA}|RA] ArgsWRedRecNo, hd-beta {coq.mk-app (F Fix) ArgsWRedRecNo} [] X XC. pred unfold % delta (global constants) + hd-beta i:constant, % name i:option univ-instance, % universe instance if the constant is universe polymorphic i:stack, % args o:term, % body o:stack. % args after hd-beta unfold GR none A BO BOC :- coq.env.const GR (some B) _, hd-beta B A BO BOC. unfold GR (some I) A BO BOC :- @uinstance! I => coq.env.const GR (some B) _, hd-beta B A BO BOC. % ensures its first argument is the whd of the second pred cache i:term, o:term. pred cache-whd i:term, i:term, i:term. cache-whd N K V :- cache N VN, var VN, !, whd V [] X XC, unwind X XC VN, K = VN. cache-whd N K _ :- cache N K, !. cache-whd N _ _ :- coq.error "anomaly: def with no cache:" {coq.term->string N}. hd-beta (app [Hd|Args]) S X C :- !, hd-beta Hd {append Args S} X C. hd-beta (fun _ _ F) [A|AS] X C :- !, hd-beta (F A) AS X C. :name "hd-beta:end" hd-beta X C X C. hd-beta-zeta (app [Hd|Args]) S X C :- !, hd-beta-zeta Hd {append Args S} X C. hd-beta-zeta (fun _ _ F) [A|AS] X C :- !, hd-beta-zeta (F A) AS X C. hd-beta-zeta (let _ _ B F) AS X C :- !, hd-beta-zeta (F B) AS X C. :name "hd-beta-zeta:end" hd-beta-zeta X C X C. hd-beta-zeta-reduce T R :- hd-beta-zeta T [] H S, unwind H S R. coq-elpi-1.19.3/elpi/elpi-tactic-template.elpi000066400000000000000000000011031451177652200211360ustar00rootroot00000000000000/* Loaded when Elpi Command is used */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ accumulate elpi/coq-lib. % basic term manipulation routines accumulate elpi/elpi-reduction. % whd, hd-beta, ... % Since the elaborator written in Elpi is not ready, we fallback to the Coq one % accumulate engine/elaborator. % of, unify accumulate elpi/coq-elaborator. accumulate elpi/elpi-ltac. % refine, or, thenl, ... coq-elpi-1.19.3/elpi/elpi_elaborator.elpi000066400000000000000000000350401451177652200203010ustar00rootroot00000000000000/* Type inference and unification */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{rev, append, ignore-failure!, mem, map2, split-at, map, assert!}. % Entry points pred unify-eq i:term, i:term. pred unify-list-eq i:list term, i:list term. pred unify-leq i:term, i:term. pred of i:term, o:term, o:term. % of Term Type(i/o) RefinedTerm %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% Reduction %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :before "hd-beta:end" hd-beta (uvar as K) [A|AS] X C :- !, % auto-intro assert! (of A TA _) "already typed", unify-eq K (fun `hd_beta_auto` TA F), hd-beta (F A) AS X C. :before "hd-beta-zeta:end" hd-beta-zeta (uvar as K) [A|AS] X C :- !, % auto-intro assert! (of A TA _) "already typed", unify-eq K (fun `hd_beta_zeta_auto` TA F), hd-beta-zeta (F A) AS X C. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% Unification %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % invariant: hd-beta terms % we start with ff, tt to handle symmetric cases % NOTE: rec-calls with unify (ensured hd-beta + ff) , symmetric rules are typically ! % NOTE: asymmetric rules are not ! otherwise the flip rule is killed % NOTE: whd are ! % names: unif X C T D M kind cumul type. type eq cumul. type leq cumul. macro @tail-cut-if Option Hd Hyps :- ( (Hd :- get-option Option tt, Hyps, !), (Hd :- not(get-option Option tt), Hyps ) ). pred unif i:term, i:stack, i:term, i:stack, i:bool, i:cumul. :if "DBG:unif" unif X CX Y CY D M :- coq.say {counter "run"} "unif" X CX "==" Y CY "(flipped?" D "cumul:" M ")", fail. pred swap i:bool, i:(A -> B -> prop), i:A, i:B. swap tt F A B :- F B A. swap ff F A B :- F A B. % flexible cases @tail-cut-if "unif:greedy" (unif (uvar V L) [] T D _ _) (!, (bind-list L {unwind T D} V)). @tail-cut-if "unif:greedy" (unif X C (uvar V L) [] _ _) (!, bind-list L {unwind X C} V). unif (sort prop) [] (sort (uvar as Y)) [] _ _ :- !, Y = prop. unif X [] (sort (uvar as Y)) [] M U :- !, coq.univ.new Lvl, Y = typ Lvl, unif X [] (sort Y) [] M U. unif (sort (uvar as X)) [] Y [] M U :- !, coq.univ.new Lvl, X = typ Lvl, unif (sort X) [] Y [] M U. unif (sort S1) [] (sort S2) [] M eq :- !, swap M coq.sort.eq S1 S2. unif (sort S1) [] (sort S2) [] M leq :- !, swap M coq.sort.leq S1 S2. unif (primitive X) [] (primitive X) [] ff _ :- !. unif (global (indt GR1)) C (global (indt GR2)) D _ _ :- !, GR1 = GR2, unify-ctxs C D. unif (global (indc GR1)) C (global (indc GR2)) D _ _ :- !, GR1 = GR2, unify-ctxs C D. unif (pglobal (indt GR1) I1) C (pglobal (indt GR2) I2) D _ eq :- !, GR1 = GR2, coq.univ-instance.unify-eq (indt GR1) I1 I2 ok, unify-ctxs C D. unif (pglobal (indt GR1) I1) C (pglobal (indt GR2) I2) D _ leq :- !, GR1 = GR2, coq.univ-instance.unify-leq (indt GR1) I1 I2 ok, unify-ctxs C D. % fast path for stuck term on the right unif X C (global (indt _) as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (global (indc _) as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (pglobal (indt _) _ as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (pglobal (indc _) _ as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 % congruence rules TODO: is the of assumption really needed? unif (fun N T1 F1) [] (fun M T2 F2) [] _ _ :- !, ignore-failure! (N = M), unify T1 T2 eq, pi x\ (decl x N T1) => unify (F1 x) (F2 x) eq. unif (prod N T1 F1) [] (prod M T2 F2) [] _ U :- !, ignore-failure! (N = M), unify T1 T2 eq, pi x\ (decl x N T1) => unify (F1 x) (F2 x) U. unif (fix N Rno Ty1 F1) B1 (fix M Rno Ty2 F2) B2 _ _ :- !, ignore-failure! (N = M), unify Ty1 Ty2 eq, (pi f\ (decl f N Ty1) => unify (F1 f) (F2 f) eq), unify-ctxs B1 B2. unif (match A1 R1 L1) B1 (match A2 R2 L2) B2 _ _ :- !, unify A1 A2 eq, unify R1 R2 eq, unify-list L1 L2, unify-ctxs B1 B2. % congruence heuristic (same maybe-non-normal head) unif (let N T1 B1 F1) C1 (let M T2 B2 F2) C2 _ _ :- ignore-failure! (N = M), unify T1 T2 eq, unify B1 B2 eq, (@pi-def N T1 B1 x\ unify (F1 x) (F2 x) eq), unify-ctxs C1 C2, !. unif (global (const GR)) C (global (const GR)) D _ _ :- unify-ctxs C D, !. unif (pglobal (const GR) I1) C (pglobal (const GR) I2) D _ eq :- coq.univ-instance.unify-eq (const GR) I1 I2 ok, unify-ctxs C D, !. unif (pglobal (const GR) I1) C (pglobal (const GR) I2) D _ leq :- coq.univ-instance.unify-leq (const GR) I1 I2 ok, unify-ctxs C D, !. unif X C T D _ _ :- name X, name T, X = T, unify-ctxs C D. % 1 step reduction TODO:1 unif (global (const GR)) C T D M U :- unfold GR none C X1 C1, !, unif X1 C1 T D M U. unif (pglobal (const GR) I) C T D M U :- unfold GR (some I) C X1 C1, !, unif X1 C1 T D M U. unif (let N TB B F) C1 T C2 M U :- !, @pi-def N TB B x\ unif {hd-beta (F x) C1} T C2 M U. unif (match A _ L) C T D M U :- whd-indc A GR KA, !, unif {match-red GR KA L C} T D M U. unif (fix _ N _ F as X) C T D M U :- nth-stack N C LA A RA, whd-indc A GR KA, !, unif {fix-red F X LA GR KA RA} T D M U. unif X C T D M U :- name X, def X _ _ V, !, unif {hd-beta V C} T D M U. % TODO we could use _VN if nonflex % TODO:1 turn into (if reducible then reduce1 else fully-reduce2 tt) % symmetry unif X C T D ff U :- !, unif T D X C tt U. % error % unif X C1 Y C2 _tt :- !, % print "Error: " {coq.term->string {unwind X C1}} "vs" {coq.term->string {unwind Y C2}}. %, halt. % Contexts happens to be lists, so we just reuse the code pred unify-list i:list term, i:list term. unify-list L1 L2 :- unify-ctxs L1 L2. % the entry points of rec calls: unify unify-ctxs pred unify-ctxs i:list term, i:list term. unify-ctxs [] []. unify-ctxs [X|XS] [Y|YS] :- unify X Y eq, !, unify-ctxs XS YS. pred unify i:term, i:term, i:cumul. unify A B C :- unif {hd-beta A []} {hd-beta B []} ff C. %%%%%% entry points for clients %%%%%%% unify-eq X Y :- unify X Y eq. unify-leq X Y :- unify X Y leq. unify-list-eq L1 L2 :- unify-list L1 L2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Flexible case %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Binding a list of terms (delift in Matita, invert subst in Coq) % We use a keyd discipline, i.e. we only bind terms with a rigid head pred key i:term. key (global _) :- !. key (pglobal _ _) :- !. key C :- name C, !. key (primitive _) :- !. pred bind-list i:list term, i:term, o:A. bind-list [] T T' :- bind T T1, T1 = T'. bind-list [app [C| AS] |VS] T R :- key C, !, pi x\ (pi L X\ bind (app[C|L]) X :- get-option "unif:greedy" tt, unify-list-eq L AS, X = x, !) => (pi L X\ bind (app[C|L]) X :- not (get-option "unif:greedy" tt),unify-list-eq L AS, X = x) => bind-list VS T (R x). bind-list [C|VS] T R :- key C, def C _ _ V, key V, !, pi x\ @tail-cut-if "unif:greedy" (bind C x) true => @tail-cut-if "unif:greedy" (bind V x) true => bind-list VS T (R x). bind-list [C|VS] T R :- key C, !, pi x\ @tail-cut-if "unif:greedy" (bind C x) true => bind-list VS T (R x). bind-list [ _ |VS] T R :- !, pi x\ bind-list VS T (R x). % CAVEAT: (app FLEX), (match _ _ FLEX) are not terms! pred bind i:term, o:term. bind X Y :- name X, X = Y, !. bind X Y :- name X, def X _ _ T, !, bind T Y. bind (global _ as C) C :- !. bind (pglobal _ _ as C) C :- !. bind (sort _ as C) C :- !. bind (fix N Rno Ty F) (fix N Rno Ty1 F1) :- !, bind Ty Ty1, pi x\ decl x N Ty => bind (F x) (F1 x). bind (match T Rty B) X :- !, bind T T1, bind Rty Rty1, map B bind B1, X = (match T1 Rty1 B1). bind (app L) X :- !, map L bind L1, X = app L1. bind (fun N T F) (fun N T1 F1) :- !, bind T T1, pi x\ decl x N T => bind (F x) (F1 x). bind (let N T B F) (let N T1 B1 F1) :- !, bind T T1, bind B B1, @pi-def N T B x\ bind (F x) (F1 x). bind (prod N T F) X :- !, bind T T1, (@pi-decl N T x\ bind (F x) (F1 x)), X = (prod N T1 F1). bind (uvar M L) W :- map L bind L1, coq.mk-app-uvar M L1 W. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Type checking %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% eat-prod head head-ty args-done todo-args refined-app refined-ty %%%%%%%% pred bidir-app i:term, i:term, i:list term, o:term. :name "of:bidirectional-app" bidir-app _ _ _ _. pred saturate-dummy i:term, o:term. saturate-dummy (prod _ _ F) R :- pi x\ saturate-dummy (F x) R. saturate-dummy X X. pred ensure-prod.aux i:list A, i:term, o:term, o:bool. ensure-prod.aux [] X X _. ensure-prod.aux [_|Args] (prod N S T) (prod N S T1) NU :- !, pi x\ ensure-prod.aux Args (T x) (T1 x) NU. ensure-prod.aux [_|Args] uvar (prod Name_ Src_ R) tt :- !, pi x\ ensure-prod.aux Args (R x) (R x) tt. ensure-prod.aux Args X R NU :- whd1 X Y, ensure-prod.aux Args Y R NU. % TODO: do not fail if whd1 fails and the term is not flexible since it % may just need to be passed a concrete argument pred ensure-prod i:list A, i:term. ensure-prod Args Ty :- ensure-prod.aux Args Ty R NeedsUnif, if (var NeedsUnif) true (of R _ R1, unify-eq Ty R1). pred eat-prod i:list term, i:term, i:term, o:list term, o:term, o:term. :if "DBG:of" eat-prod [] Hd Prod Adone Res ResTy :- coq.say "eat-prod" Hd {rev Adone} "==" Res ";" Prod "=<=" ResTy, fail. eat-prod [] Hd Prod Adone Res ResTy :- !, rev Adone Args, unify-eq Res {coq.mk-app Hd Args}, unify-leq Prod ResTy. % XXX why not unif? eat-prod [A|AS] Hd (prod _ Src Tgt as Prod) Adone Res ResTy :- bidir-app Hd Prod Adone ResTy, of A Src ResA, eat-prod AS Hd (Tgt ResA) [ResA|Adone] Res ResTy. % TODO: add a whd1 eg in case of a n-ary function :if "DBG:of" of X Tx Rx :- coq.say {counter "run"} "of" X Tx Rx, fail. of X Tx R :- name X, (decl X _ T ; def X _ T _), unify-leq T Tx, R = X. of (fun N S F) LamTy (fun M S2 F2) :- of (prod N S _) (sort _U) (prod M S2 T), unify-leq (prod M S2 T) LamTy, pi x\ decl x M S2 => of (F x) (T x) (F2 x). of (app [X]) Ty R :- !, of X Ty R. of (app [Hd|Args]) TyApp App :- of Hd Prod Hd1, ensure-prod Args Prod, eat-prod Args Hd1 Prod [] App TyApp. of (prod N S F) ProdTy (prod N ResS ResF) :- closed_term U1, closed_term U2, closed_term U, of S (sort U1) ResS, (pi x\ decl x N ResS => of (F x) (sort U2) (ResF x)), pts U1 U2 U, unify-leq (sort U) ProdTy. of (match T Rty Bs) ResRtyInst (match ResT ResRty ResBs) :- of T TyT ResT, % T : TyT = (indt GR) LArgs RArgs, and (indt GR) : Ty coq.safe-dest-app TyT (global (indt GR)) Args, coq.env.indt GR _IsInd Lno _Luno Ty Kn Ks, % TODO LUno split-at Lno Args LArgs RArgs, % TODO: not a failure, just type err % fix LArgs on ind ty and constructors ty coq.subst-prod LArgs Ty TyLArgs, map Ks (coq.subst-prod LArgs) KsLArgs, % Rty skeleton (uknown ending) = fun rargs, fun e : indt largs rargs, ? mk-rty [] {coq.mk-app (global (indt GR)) LArgs} TyLArgs ResRtyRaw, of ResRtyRaw _ ResRty, unify-eq Rty ResRty, % Rty must type each branch map2 KsLArgs Kn (mk-bty Rty Lno) BsTy, map2 Bs BsTy of ResBs, % Outside type unify-leq {coq.mk-app ResRty {append RArgs [ResT]}} ResRtyInst. of (let N Ty Bo F) TyFx (let N ResTy ResBo ResF) :- of Ty (sort _) ResTy, of Bo ResTy ResBo, pi x\ def x N ResTy ResBo => cache x T_ => of (F x) TyFx (ResF x). of (fix N Rno Ty BoF) ResTy (fix N Rno RTy ResBoF) :- of Ty (sort _) RTy, unify-leq RTy ResTy, pi f\ decl f N RTy => of (BoF f) ResTy (ResBoF f). of (sort S) (sort S1) (sort S) :- coq.sort.sup S S1. of (global GR as X) T X :- coq.env.typeof GR T1, unify-leq T1 T. of (pglobal GR I as X) T X :- @uinstance! I => coq.env.typeof GR T1, unify-leq T1 T. of (primitive (uint63 _) as X) T X :- unify-leq {{ lib:elpi.uint63 }} T. of (primitive (float64 _) as X) T X :- unify-leq {{ lib:elpi.float64 }} T. of (uvar as X) T Y :- !, evar X T Y. :if "OVERRIDE_COQ_ELABORATOR" :name "refiner-assign-evar" :before "default-assign-evar" evar X Ty S :- !, of X Ty S. pred coerce o:term, o:term, o:term, o:term. pred coerced i:term, i:term, i:term, o:term. pred coerceible i:term, o:term, i:term, o:term. of X T R :- get-option "of:coerce" tt, not (var T), of X XT Y, coerced XT T Y R. :if "DBG:of" of X Tx Rx :- coq.say {counter "run"} "of [FAIL]" X Tx Rx, fail. pred utc % Uniqueness of typing i:list term, % names (canonical) i:term, % type living in names i:list term, % values (explicit subst on names) i:term, % type living in values o:prop. % goal checking compatibility of the two types utc [] T1 [] T2 (unify-eq T1V T2) :- !, copy T1 T1V. utc [N|NS] T1 [V|VS] T2 C :- !, copy N V => utc NS T1 VS T2 C. utc [] T1 VS T2 C :- !, utc [] {coq.subst-prod VS T1} [] T2 C. % FIXME: reduction utc [_|NS] (prod _ _ F) [] T2 C :- !, % FIXME: reduction assert! (pi x\ F x = F1) "restriction bug", utc NS F1 [] T2 C. % This could be done in ML pred canonical? i:list term. canonical? []. canonical? [N|NS] :- name N, not(mem NS N), canonical? NS. constraint declare-evar evar decl def cache rm-evar { rule (E1 : G1 ?- evar _ T1 (uvar K L1)) % canonical \ (E2 : G2 ?- evar _ T2 (uvar K L2)) % actual | (canonical? L1, utc L1 T1 L2 T2 Condition, coq.say "CHR: Uniqueness of typing of" K "+" L1 "<->" L2, coq.say E1 "|>" G1 "|-" K L1 ":" T1, coq.say E2 "|>" G2 "|-" K L2 ":" T2, coq.say E2 "|>" G2 "|-" Condition "\n" ) <=> (E2 : G2 ?- Condition). } % typing match %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% type mk-rty list term -> term -> term -> term -> prop. mk-rty ARGS HD (prod N S T) (fun N S F) :- !, pi x\ mk-rty [x|ARGS] HD (T x) (F x). mk-rty ARGS HD _ (fun _ IndApp _FRESH) :- coq.mk-app HD {rev ARGS} IndApp. type mk-bty term -> int -> term -> constructor -> term -> prop. mk-bty Rty Lno (prod N S T) Ki (prod N S B) :- !, pi x\ mk-bty Rty Lno (T x) Ki (B x). mk-bty Rty Lno T Ki AppRtyNorm :- coq.safe-dest-app T (global (indt _)) Args, split-at Lno Args LArgs RArgs, coq.mk-app Rty {append RArgs [{coq.mk-app (global (indc Ki)) {append LArgs RArgs}}]} AppRty, hd-beta-zeta-reduce AppRty AppRtyNorm. mk-bty Rty Lno T Ki AppRtyNorm :- coq.safe-dest-app T (pglobal (indt _) I) Args, split-at Lno Args LArgs RArgs, coq.mk-app Rty {append RArgs [{coq.mk-app (pglobal (indc Ki) I) {append LArgs RArgs}}]} AppRty, hd-beta-zeta-reduce AppRty AppRtyNorm. % PTS sorts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred pts i:sort, i:sort, o:sort. pts X Y U :- coq.sort.pts-triple X Y U. coq-elpi-1.19.3/etc/000077500000000000000000000000001451177652200141035ustar00rootroot00000000000000coq-elpi-1.19.3/etc/alectryon_elpi.py000077500000000000000000000274211451177652200174770ustar00rootroot00000000000000#!/usr/bin/env python3 import sys from os.path import join, dirname # This is a custom driver: it exposes the same interface as # Alectryon's usual CLI, but: # - it sets the internal parameter pp_margin of SerAPI to a different value # - it installs a new ghref RST role # - it install a new pygments lexer for Elpi # - it patches Coq's pygments lexer to handle quotations to Elpi root = join(dirname(__file__), "..") sys.path.insert(0, root) # SERAPI ###################################################################### from alectryon.cli import main from alectryon.serapi import SerAPI SerAPI.DEFAULT_PP_ARGS['pp_margin'] = 55 # PYGMENTS ELPI ############################################################### from pygments.lexer import RegexLexer, default, words, bygroups, include, inherit from pygments.regexopt import regex_opt, regex_opt_inner from pygments.token import \ Text, Comment, Operator, Keyword, Name, String, Number class ElpiLexer(RegexLexer): """ For the `Elpi `_ programming language. .. versionadded:: 1.0 """ name = 'Elpi' aliases = ['elpi'] filenames = ['*.elpi'] mimetypes = ['text/x-elpi'] lcase_re = r"[a-z]" ucase_re = r"[A-Z]" digit_re = r"[0-9]" schar2_re = r"(\+|\*|/|\^|<|>|`|'|\?|@|#|~|=|&|!)" schar_re = r"({}|-|\$|_)".format(schar2_re) idchar_re = r"({}|{}|{}|{})".format(lcase_re,ucase_re,digit_re,schar_re) idcharstarns_re = r"({}+|(?=\.[a-z])\.{}+)".format(idchar_re,idchar_re) symbchar_re = r"({}|{}|{}|{}|:)".format(lcase_re, ucase_re, digit_re, schar_re) constant_re = r"({}{}*|{}{}*|{}{}*|_{}+)".format(ucase_re, idchar_re, lcase_re, idcharstarns_re,schar2_re, symbchar_re,idchar_re) symbol_re=r"(,|<=>|->|:-|;|\?-|->|&|=>|as|<|=<|=|==|>=|>|i<|i=<|i>=|i>|is|r<|r=<|r>=|r>|s<|s=<|s>=|s>|@|::|`->|`:|`:=|\^|-|\+|i-|i\+|r-|r\+|/|\*|div|i\*|mod|r\*|~|i~|r~)" escape_re=r"\(({}|{})\)".format(constant_re,symbol_re) const_sym_re = r"({}|{}|{})".format(constant_re,symbol_re,escape_re) tokens = { 'root': [ include('elpi') ], 'elpi': [ include('_elpi-comment'), (r"(:before|:after|:if|:name)(\s*)(\")",bygroups(Keyword.ElpiMode,Text,String.Double),'elpi-string'), (r"(:index)(\s*\()",bygroups(Keyword.ElpiMode,Text),'elpi-indexing-expr'), (r"\b(external pred|pred)(\s+)({})".format(const_sym_re),bygroups(Keyword.ElpiKeyword,Text,Name.ElpiFunction),'elpi-pred-item'), (r"\b(external type|type)(\s+)(({}(,\s*)?)+)".format(const_sym_re),bygroups(Keyword.ElpiKeyword,Text,Name.ElpiFunction),'elpi-type'), (r"\b(kind)(\s+)(({}|,)+)".format(const_sym_re),bygroups(Keyword.ElpiKeyword,Text,Name.ElpiFunction),'elpi-type'), (r"\b(typeabbrev)(\s+)({})".format(const_sym_re),bygroups(Keyword.ElpiKeyword,Text,Name.ElpiFunction),'elpi-type'), (r"\b(accumulate)(\s+)(\")",bygroups(Keyword.ElpiKeyword,Text,String.Double),'elpi-string'), (r"\b(accumulate|shorten|namespace|local)(\s+)({})".format(constant_re),bygroups(Keyword.ElpiKeyword,Text,Text)), (r"\b(pi|sigma)(\s+)([a-zA-Z][A-Za-z0-9_ ]*)(\\)",bygroups(Keyword.ElpiKeyword,Text,Name.ElpiVariable,Text)), (r"\brule\b",Keyword.ElpiKeyword), (r"\b(constraint)(\s+)(({}(\s+)?)+)".format(const_sym_re),bygroups(Keyword.ElpiKeyword,Text,Name.ElpiFunction)), (r"(?=[A-Z_]){}".format(constant_re),Name.ElpiVariable), (r"(?=[a-z_]){}\\".format(constant_re),Name.ElpiVariable), (r"_",Name.ElpiVariable), (r"({}|!|=>|;)".format(symbol_re),Keyword.ElpiKeyword), (constant_re,Text), (r"\[|\]|\||=>",Keyword.ElpiKeyword), (r'"', String.Double, 'elpi-string'), (r'`', String.Double, 'elpi-btick'), (r'\'', String.Double, 'elpi-tick'), (r'\{[^\{]', Text, 'elpi-spill'), (r"\(",Text,'elpi-in-parens'), (r'\d[\d_]*', Number.ElpiInteger), (r'-?\d[\d_]*(.[\d_]*)?([eE][+\-]?\d[\d_]*)', Number.ElpiFloat), (r"[+\*-/\^]", Operator), ], '_elpi-comment': [ (r'%[^\n]*\n',Comment), (r'/\*',Comment,'elpi-multiline-comment'), (r"\s+",Text), ], 'elpi-multiline-comment': [ (r'\*/',Comment,'#pop'), (r'.',Comment) ], 'elpi-indexing-expr':[ (r'[0-9 _]+',Number.ElpiInteger), (r'\)',Text,'#pop'), ], 'elpi-type': [ (r"(ctype\s+)(\")",bygroups(Keyword.Type,String.Double),'elpi-string'), (r'->',Keyword.Type), (constant_re,Keyword.Type), (r"\(|\)",Keyword.Type), (r"\.",Text,'#pop'), include('_elpi-comment'), ], 'elpi-pred-item': [ (r"[io]:",Keyword.ElpiMode,'elpi-ctype'), (r"\.",Text,'#pop'), include('_elpi-comment'), ], 'elpi-ctype': [ (r"(ctype\s+)(\")",bygroups(Keyword.Type,String.Double),'elpi-string'), (constant_re,Keyword.Type), (r"\(|\)",Keyword.Type), (r",",Text,'#pop'), (r"\.",Text,'#pop:2'), include('_elpi-comment'), ], 'elpi-btick': [ (r'[^` ]+', String.Double), (r'`', String.Double, '#pop'), ], 'elpi-tick': [ (r'[^\' ]+', String.Double), (r'\'', String.Double, '#pop'), ], 'elpi-string': [ (r'[^\"]+', String.Double), (r'"', String.Double, '#pop'), ], 'elpi-spill': [ (r'\{[^\{]', Text, '#push'), (r'\}[^\}]', Text, '#pop'), include('elpi'), ], 'elpi-in-parens': [ (r"\(", Operator, '#push'), (r"\)", Operator, '#pop'), include('elpi'), ], } from pygments.lexers._mapping import LEXERS LEXERS['ElpiLexer'] = ('alectryon_elpi','Elpi',('elpi',),('*.elpi',),('text/x-elpi',)) # PYGMENTS COQ-ELPI ########################################################### from alectryon.pygments_lexer import CoqLexer class CoqElpiLexer(CoqLexer, ElpiLexer): tokens = { 'root': [ # No clue what inherit would do here, so we copy Coq's ones include('_basic'), include('_vernac'), include('_keywords'), include('_other'), ], '_quotations': [ (r"lp:\{\{",String.Interpol, 'elpi'), (r"(lp:)([A-Za-z_0-9']+)",bygroups(String.Interpol, Name.ElpiVariable)), (r"(lp:)(\()([A-Z][A-Za-z_0-9']*)([a-z0-9 ]+)(\))",bygroups(String.Interpol,String.Interpol,Name.ElpiVariable,Text,String.Interpol)), ], 'antiquotation': [ (r"\}\}",String.Interpol,'#pop'), include('root') ], 'elpi': [ (r"\}\}",String.Interpol,'#pop'), (r"\b(global|sort|app|fun|let|prod|match|fix)\b", Keyword.ElpiKeyword), (r"\{\{(:[a-z]+)?",String.Interpol,'antiquotation'), # back to Coq inherit ], '_other': [ include('_quotations'), inherit ], } import alectryon.pygments_lexer alectryon.pygments_lexer.CoqLexer = CoqElpiLexer # DOCUTILS #################################################################### import docutils from docutils.parsers.rst import directives, roles # type: ignore from docutils import nodes def set_line(node, lineno, sm): node.source, node.line = sm.get_source_and_line(lineno) import re import time import pickle import atexit ghref_cache = {} def dump_ghref_cache(): when = int(time.time() / 1000) file = '/tmp/ghref_cache_{}'.format(str(when)) pickle.dump(ghref_cache,open(file,'wb')) atexit.register(dump_ghref_cache) try: when = int(time.time() / 1000) file = '/tmp/ghref_cache_{}'.format(str(when)) ghref_cache = pickle.load(open(file,'rb')) #print('loaded cache', when, file) except: #print('failed to loaded cache', file) ghref_cache = {} ghref_scrape_re = re.compile("\"sha\"[: ]*\"([a-zA-Z0-9]+)\"",re.IGNORECASE) def ghref_role(role, rawtext, text, lineno, inliner, options={}, content=[]): src = options.get('src',None) if src is None: msg = inliner.reporter.error("{}: no src option".format(role), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] components = str.split(src,sep=" ") if len(components) != 4: msg = inliner.reporter.error("{}: src should be 4 space separated strings".format(role), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] org, repo, branch, path = components uri = "https://github.com/{}/{}/blob/{}/{}".format(org,repo,branch,path) roles.set_classes(options) options.setdefault("classes", []).append("ghref") if uri in ghref_cache: code, rawuri, uri = ghref_cache[uri] else: from urllib import request apiuri = "https://api.github.com/repos/{}/{}/commits/{}/branches-where-head".format(org,repo,branch) try: with request.urlopen(apiuri) as f: json = f.read().decode('utf-8') except: msg = inliner.reporter.error("{}: could not download: {}".format(role,apiuri), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] try: # A json parser would be nicer sha = ghref_scrape_re.search(json).group(1) except: msg = inliner.reporter.error("{}: could not scrape for permalink: {}".format(role,uri), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] puri = "https://github.com/{}/{}/blob/{}/{}".format(org,repo,sha,path) rawuri = "https://raw.githubusercontent.com/{}/{}/{}/{}".format(org,repo,sha,path) try: with request.urlopen(rawuri) as f: code = f.read().decode('utf-8') except: msg = inliner.reporter.error("{}: could not download: {}".format(role,rawuri), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] ghref_cache[uri]=(code,rawuri,puri) uri=puri mangler = options.get('replace',None) mangler_with = options.get('replace_with','') if mangler is None: name = text else: name = re.sub(mangler,mangler_with,text) pattern = options.get('pattern','') from string import Template pattern = Template(pattern).safe_substitute(name = re.escape(name)) pattern = re.compile(pattern) for num, line in enumerate(code.splitlines(), 1): if pattern.search(line): uri = uri + '#L' + str(num) break else: msg = inliner.reporter.error("{}: {} not found in {} using pattern {}".format(role,text,rawuri,pattern), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] node = nodes.reference(rawtext, text, refuri=uri, **options) set_line(node, lineno, inliner.reporter) return [node], [] ghref_role.name = "ghref" ghref_role.options = { # the GH source, 4 fields separated by space: org repo branch path. Eg # :src: cpitclaudel alectryon master alectryon/docutils.py "src": directives.unchanged, # the regex to find the location in the raw file at path. I must use $name # this is replaced by the text in :ghref:`text`. Eg # :pattern: ^def $name "pattern": directives.unchanged, # optionally mangle the name before substituting it in the regexp using # re.sub. Eg # :replace: this # :replace_with: that "replace": directives.unchanged, "replace_with": directives.unchanged } roles.register_canonical_role("ghref", ghref_role) ############################################################################### __all__ = [ "ElpiLexer", "CoqElpiLexer"] if __name__ == "__main__": main() coq-elpi-1.19.3/etc/coq-elpi.lang000066400000000000000000000273501451177652200164660ustar00rootroot00000000000000 *.v \(\* \*\)