pax_global_header00006660000000000000000000000064142004633400014506gustar00rootroot0000000000000052 comment=3330d8efcc312244a9fbc883b8ce1a6a7cce6dc7 coq-elpi-1.13.0/000077500000000000000000000000001420046334000133015ustar00rootroot00000000000000coq-elpi-1.13.0/.gitattributes000066400000000000000000000000401420046334000161660ustar00rootroot00000000000000*.elpi linguist-language=prolog coq-elpi-1.13.0/.github/000077500000000000000000000000001420046334000146415ustar00rootroot00000000000000coq-elpi-1.13.0/.github/workflows/000077500000000000000000000000001420046334000166765ustar00rootroot00000000000000coq-elpi-1.13.0/.github/workflows/doc.yml000066400000000000000000000024641420046334000201740ustar00rootroot00000000000000# 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: checkout uses: actions/checkout@v2 - name: setup ocaml uses: avsm/setup-ocaml@v1 with: ocaml-version: 4.07.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@v1.4.0 - 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.13.0/.github/workflows/main.yml000066400000000000000000000014201420046334000203420ustar00rootroot00000000000000# 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 ] pull_request: branches: [ master, coq-master ] jobs: build: runs-on: ubuntu-latest strategy: matrix: coq_version: - '8.15' ocaml_version: - '4.07-flambda' - '4.11-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' env: OPAMWITHTEST: 'true' coq-elpi-1.13.0/.github/workflows/nix-action-default.yml000066400000000000000000000275561420046334000231330ustar00rootroot00000000000000jobs: coq: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout uses: actions/checkout@v2 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v16 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v10 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepCheck name: Checking presence of CI target coq run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"default\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ \ \"built:\" | sed \"s/.*/built/\")\n" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "coq" coq-elpi: needs: - coq runs-on: ubuntu-latest steps: - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout uses: actions/checkout@v2 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v16 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v10 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepCheck name: Checking presence of CI target coq-elpi run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"default\" --argstr job \"coq-elpi\" \\\n --dry-run 2>&1 > /dev/null)\n\ echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ \ \"built:\" | sed \"s/.*/built/\")\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "coq" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "coq-elpi" graph-theory: needs: - coq - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout uses: actions/checkout@v2 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v16 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v10 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepCheck name: Checking presence of CI target graph-theory run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"default\" --argstr job \"graph-theory\" \\\n --dry-run 2>&1 >\ \ /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ \ | grep \"built:\" | sed \"s/.*/built/\")\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "coq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "graph-theory" hierarchy-builder: needs: - coq - coq-elpi runs-on: ubuntu-latest steps: - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout uses: actions/checkout@v2 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v16 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v10 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepCheck name: Checking presence of CI target hierarchy-builder run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"default\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2>&1\ \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ \ | grep \"built:\" | sed \"s/.*/built/\")\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "coq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "hierarchy-builder" mathcomp-analysis: needs: - coq - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout uses: actions/checkout@v2 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v16 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v10 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepCheck name: Checking presence of CI target mathcomp-analysis run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"default\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1\ \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ \ | grep \"built:\" | sed \"s/.*/built/\")\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "coq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "default" --argstr job "mathcomp-analysis" name: Nix CI for bundle default 'on': pull_request: paths: - .github/workflows/** pull_request_target: types: - opened - synchronize - reopened push: branches: - master coq-elpi-1.13.0/.gitignore000066400000000000000000000005651420046334000152770ustar00rootroot00000000000000*.o *.cmx *.cmo *.cmi *.a *.cmxa *.cmxs *.cma *.cmt *.cmti *.annot .*~ .*.swp *.vo *.vos *.vok *.d *.glob .*.aux *.html *.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.test.coq Makefile.test.coq.conf coq-elpi-1.13.0/.nix/000077500000000000000000000000001420046334000141555ustar00rootroot00000000000000coq-elpi-1.13.0/.nix/config.nix000066400000000000000000000100561420046334000161440ustar00rootroot00000000000000{ ## DO NOT CHANGE THIS format = "1.0.0"; ## unless you made an automated or manual update ## to another supported format. ## The attribute to build from the local sources, ## either using nixpkgs data or the overlays located in `.nix/coq-overlays` ## Will determine the default main-job of the bundles defined below attribute = "coq-elpi"; ## If you want to select a different attribute (to build from the local sources as well) ## when calling `nix-shell` and `nix-build` without the `--argstr job` argument # shell-attribute = "{{nix_name}}"; ## Maybe the shortname of the library is different from ## the name of the nixpkgs attribute, if so, set it here: # pname = "{{shortname}}"; ## Lists the dependencies, phrased in terms of nix attributes. ## No need to list Coq, it is already included. ## These dependencies will systematically be added to the currently ## known dependencies, if any more than Coq. ## /!\ Remove this field as soon as the package is available on nixpkgs. ## /!\ Manual overlays in `.nix/coq-overlays` should be preferred then. # buildInputs = [ ]; ## Indicate the relative location of your _CoqProject ## If not specified, it defaults to "_CoqProject" # coqproject = "_CoqProject"; ## select an entry to build in the following `bundles` set ## defaults to "default" default-bundle = "default"; ## write one `bundles.name` attribute set per ## alternative configuration ## When generating GitHub Action CI, one workflow file ## will be created per bundle bundles.default = { ## You can override Coq and other Coq coqPackages ## through the following attribute coqPackages.coq.override.version = "8.15"; coqPackages.hierarchy-builder.override.version = "master"; coqPackages.graph-theory.override.version = "master"; coqPackages.mathcomp-analysis.override.version = "master"; ## In some cases, light overrides are not available/enough ## in which case you can use either # coqPackages..overrideAttrs = o: ; ## or a "long" overlay to put in `.nix/coq-overlays ## you may use `nix-shell --run fetchOverlay ` ## to automatically retrieve the one from nixpkgs ## if it exists and is correctly named/located ## You can override Coq and other coqPackages ## through the following attribute ## If does not support light overrides, ## you may use `overrideAttrs` or long overlays ## located in `.nix/ocaml-overlays` ## (there is no automation for this one) # ocamlPackages..override.version = "x.xx"; ## You can also override packages from the nixpkgs toplevel # .override.overrideAttrs = o: ; ## Or put an overlay in `.nix/overlays` ## you may mark a package as a main CI job (one to take deps and ## rev deps from) as follows # coqPackages..main-job = true; ## by default the current package and its shell attributes are main jobs ## you may mark a package as a CI job as follows # coqPackages..job = "test"; ## It can then built through ## nix-build --argstr bundle "default" --arg job "test"; ## in the absence of such a directive, the job "another-pkg" will ## is still available, but will be automatically included in the CI ## via the command genNixActions only if it is a dependency or a ## reverse dependency of a job flagged as "main-job" (see above). }; ## Cachix caches to use in CI ## Below we list some standard ones cachix.coq = {}; cachix.math-comp = {}; cachix.coq-community = {}; ## If you have write access to one of these caches you can ## provide the auth token or signing key through a secret ## variable on GitHub. Then, you should give the variable ## name here. For instance, coq-community projects can use ## the following line instead of the one above: cachix.coq-elpi.authToken = "CACHIX_AUTH_TOKEN"; ## Note that here, CACHIX_AUTH_TOKEN and CACHIX_SIGNING_KEY ## are the names of secret variables. They are set in ## GitHub's web interface. } coq-elpi-1.13.0/.nix/coq-nix-toolbox.nix000066400000000000000000000000531420046334000177350ustar00rootroot00000000000000"ccef60688648484a499d367b1e916e8bd36db789" coq-elpi-1.13.0/.vscode/000077500000000000000000000000001420046334000146425ustar00rootroot00000000000000coq-elpi-1.13.0/.vscode/settings.json000066400000000000000000000016171420046334000174020ustar00rootroot00000000000000{ "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" }coq-elpi-1.13.0/Changelog.md000066400000000000000000000714231420046334000155210ustar00rootroot00000000000000# Changelog ## [1.13.0] - 08-02-2022 ### 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.13.0/LICENSE000066400000000000000000000635351420046334000143220ustar00rootroot00000000000000 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.13.0/Makefile000066400000000000000000000074761420046334000147570ustar00rootroot00000000000000 # 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) ifeq "$(COQ_ELPI_ALREADY_INSTALLED)" "" DOCDEP=build else DOCDEP= endif DOCDIR=$(shell $(COQBIN)/coqc -where)/../../share/doc/coq-elpi/ all: build test build: 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 @echo "########################## building APPS ############################" @$(foreach app,$(APPS),$(MAKE) -C $(app) $@ &&) true test: Makefile.test.coq $(DEPS) build @echo "########################## testing plugin ##########################" @$(MAKE) --no-print-directory -f Makefile.test.coq @echo "########################## testing APPS ############################" @$(foreach app,$(APPS),$(MAKE) -C $(app) $@ &&) true 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/ .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 @$(COQBIN)/coq_makefile -f _CoqProject.test -o Makefile.test.coq src/coq_elpi_builtins_HOAS.ml: elpi/coq-HOAS.elpi Makefile.coq.local echo "(* Automatically generated from $<, don't edit *)" > $@ echo "let code = {|" >> $@ cat $< >> $@ echo "|}" >> $@ src/coq_elpi_config.ml: echo "let elpi_dir = \"$(abspath $(ELPIDIR))\";;" > $@ clean: @$(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 $(DESTDIR)$(DOCDIR) -cp doc/* $(DESTDIR)$(DOCDIR) @echo "########################## installed ############################" # compile just one file 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 $@ SPACE=$(XXX) $(YYY) apps/%.vo: force @$(MAKE) -C apps/$(word 1,$(subst /, ,$*)) \ $(subst $(SPACE),/,$(wordlist 2,99,$(subst /, ,$*))).vo coq-elpi-1.13.0/Makefile.coq.local000066400000000000000000000012561420046334000166170ustar00rootroot00000000000000CAMLPKGS+= -package elpi,stdlib-shims CAMLFLAGS+= -bin-annot -g OCAMLWARN+=-warn-error -32 theories/elpi.vo: $(wildcard elpi/*.elpi) merlin-hook:: echo "PKG camlp5" >> .merlin 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.13.0/Makefile.test.coq.local000066400000000000000000000002251420046334000175700ustar00rootroot00000000000000tests/test_cache_async.vo: COQEXTRAFLAGS=-async-proofs on tests/test_COQ_ELPI_ATTRIBUTES.vo: export COQ_ELPI_ATTRIBUTES=test=yes,str="some-string" coq-elpi-1.13.0/README.md000066400000000000000000000421511420046334000145630ustar00rootroot00000000000000[![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 a quotation and anti-quotation for Coq's syntax, so that one can write `{{ nat -> lp:X }}` in the middle of a λProlog program instead of the equivalent AST ``prod `_` (global (indt «Coq.Init.Datatypes.nat»)) X``. ## 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. In addition to that Elpi extends λProlog with higher order constraints, a language feature that helps to manipulate terms containing not only binders, but also unification variables (evars, in Coq's slang). As ongoing research we are looking forward to express algorithms like higher order unification and type inference 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 and use `Elpi Accumulate File "filename" From some.load.path.` instead. CoqIDE does not handle quotations correctly. 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`. If you use Vim, we recommend to add the following lines to `~/.vimrc` (in addition to the ones for [elpi](https://github.com/LPCIC/elpi#syntax-highlight-in-vim))

(click to expand)

```vim "coq-elpi autocmd FileType lprolog syn keyword coqElpiSpecial fun prod sort let match fix axiom indc indt const prop app autocmd FileType lprolog syn cluster elpiAntiQuotation contains=elpiAntiQuotationVar,elpiAntiQuotationBound,elpiAntiQuotationTerm autocmd FileType lprolog syn region elpiAntiQuotationTerm start=+lp:"+ end=+"+ contains=elpiQuotation,lprologVariable,coqElpiSpecial,elpiMacro,lprologSpecial autocmd FileType lprolog syn match elpiAntiQuotationVar "lp:[A-Z_-]\+"ms=s+3 autocmd FileType lprolog syn match elpiAntiQuotationBound "lp:[a-z_-]\+" autocmd FileType lprolog hi def link elpiAntiQuotationVar Keyword autocmd FileType lprolog hi def link elpiAntiQuotationBound Normal autocmd FileType lprolog hi def link coqElpiSpecial Special ```

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)).

## 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) - [record import](examples/example_import_projections.v) gives short names to record projections applied to the given record instance. ### 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. - [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 - [Namespace Emulation System](apps/NES/examples/usage_NES.v) implements most of the features of namespaces (on top of Coq's modules). ### 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` (or `` if provided filtering out clauses whose file/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_attributes:(v)` (for `v` of type `attributes`) For example: ```coq Tactic Notation "tac" string(X) ident(Y) int(Z) hyp(T) constr_list(L) := elpi tac ltac_string:(X) ltac_string:(Y) ltac_int:(Z) ltac_term:(T) ltac_term_list:(L). ``` lets one write `tac "a" b 3 H t1 t2 t3` 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 Terms passed to Elpi commands code via `(term)` or via a declaration (like `Record`, `Inductive` ...) are in raw format. 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). Type checking/inference is not performed: the `coq.typecheck` or `coq.elaborate-skeleton` APIs can be used to fill in implicit arguments and insert coercions. 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`).

#### 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.13.0/_CoqProject000066400000000000000000000021271420046334000154360ustar00rootroot00000000000000-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 theories/elpi.v theories/wip/memoization.v -I src src/coq_elpi_vernacular_syntax.mlg src/coq_elpi_vernacular.ml src/coq_elpi_vernacular.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.13.0/_CoqProject.test000066400000000000000000000015571420046334000164220ustar00rootroot00000000000000-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 tests/test_API.v tests/test_API2.v tests/test_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_cache_async.v tests/test_COQ_ELPI_ATTRIBUTES.v tests/perf_calls.v tests/test_require_bad_order.v tests/test_ctx_cache.v coq-elpi-1.13.0/apps/000077500000000000000000000000001420046334000142445ustar00rootroot00000000000000coq-elpi-1.13.0/apps/NES/000077500000000000000000000000001420046334000146715ustar00rootroot00000000000000coq-elpi-1.13.0/apps/NES/Makefile000066400000000000000000000022111420046334000163250ustar00rootroot00000000000000# 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: @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.13.0/apps/NES/Makefile.coq.local000066400000000000000000000000511420046334000201770ustar00rootroot00000000000000theories/NES.vo: $(wildcard elpi/*.elpi) coq-elpi-1.13.0/apps/NES/_CoqProject000066400000000000000000000002541420046334000170250ustar00rootroot00000000000000# 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.13.0/apps/NES/_CoqProject.test000066400000000000000000000004431420046334000200030ustar00rootroot00000000000000# 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.NES.tests -R examples elpi.apps.NES.examples tests/test_NES.v tests/test_NES_perf.v tests/test_NES_perf_optimal.v examples/usage_NES.vcoq-elpi-1.13.0/apps/NES/elpi/000077500000000000000000000000001420046334000156225ustar00rootroot00000000000000coq-elpi-1.13.0/apps/NES/elpi/nes.elpi000066400000000000000000000073611420046334000172710ustar00rootroot00000000000000namespace 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. begin-ns NS Path :- 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, @local! => coq.elpi.accumulate current "NES.db" (clause _ (after "open-ns:begin") (open-ns NS CP)). 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 -> prop). iter<- _ [] _ :- coq.error "No elements". iter<- INIT [X] F :- !, F X INIT. iter<- INIT [X|XS] F :- iter<- INIT XS F, F X {std.append XS INIT}. pred string->ns i:string, o:list string. string->ns S L :- rex_split "\\." S L. :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. begin-path Path :- 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, 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, 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. end-path Path :- 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 [] _, ]. 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. }coq-elpi-1.13.0/apps/NES/examples/000077500000000000000000000000001420046334000165075ustar00rootroot00000000000000coq-elpi-1.13.0/apps/NES/examples/usage_NES.v000066400000000000000000000031771420046334000205170ustar00rootroot00000000000000From 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 *) (* 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.13.0/apps/NES/tests/000077500000000000000000000000001420046334000160335ustar00rootroot00000000000000coq-elpi-1.13.0/apps/NES/tests/test_NES.v000066400000000000000000000020231420046334000177030ustar00rootroot00000000000000From elpi.apps Require Import NES. (* 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.13.0/apps/NES/tests/test_NES_perf.v000066400000000000000000000623321420046334000207300ustar00rootroot00000000000000From 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.13.0/apps/NES/tests/test_NES_perf_optimal.v000066400000000000000000001210261420046334000224510ustar00rootroot00000000000000From 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.13.0/apps/NES/theories/000077500000000000000000000000001420046334000165135ustar00rootroot00000000000000coq-elpi-1.13.0/apps/NES/theories/NES.v000066400000000000000000000026531420046334000173350ustar00rootroot00000000000000From 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" From elpi.apps.NES. Elpi Accumulate lp:{{ main _ :- std.map {std.findall (open-ns X_ P_)} nes.open-ns->string Stack, coq.say "NES: current namespace" {nes.join "." {std.rev Stack} }, 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" From elpi.apps.NES. Elpi Accumulate lp:{{ main [str NS] :- nes.begin-path {nes.string->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" From elpi.apps.NES. Elpi Accumulate lp:{{ main [str NS] :- nes.end-path {nes.string->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" From elpi.apps.NES. Elpi Accumulate lp:{{ main [str NS] :- nes.open-path {nes.string->ns NS}. main _ :- coq.error "usage: NES.Open ". }}. Elpi Typecheck. Elpi Export NES.Open. coq-elpi-1.13.0/apps/README.md000066400000000000000000000005141420046334000155230ustar00rootroot00000000000000## 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.13.0/apps/derive/000077500000000000000000000000001420046334000155225ustar00rootroot00000000000000coq-elpi-1.13.0/apps/derive/Makefile000066400000000000000000000022111420046334000171560ustar00rootroot00000000000000# 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: @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.13.0/apps/derive/Makefile.coq.local000066400000000000000000000026041420046334000210360ustar00rootroot00000000000000theories/derive.vo: $(wildcard elpi/*.elpi) theories/derive/bcongr.vo: elpi/bcongr.elpi theories/derive/eqK.vo: elpi/eqK.elpi theories/derive/eq.vo: elpi/eq.elpi theories/derive/invert.vo: elpi/invert.elpi theories/derive/param1_congr.vo: elpi/param1_congr.elpi theories/derive/param1_trivial.vo: elpi/param1_trivial.elpi theories/derive/projK.vo: elpi/projK.elpi theories/derive/cast.vo: elpi/cast.elpi theories/derive/eqOK_trivial.vo: elpi/eqOK_trivial.elpi theories/derive/idx2inv.vo: elpi/idx2inv.elpi theories/derive/isK.vo: elpi/isK.elpi theories/derive/param1_functor.vo: elpi/param1_functor.elpi theories/derive/param1.vo: elpi/param1.elpi elpi/paramX-lib.elpi theories/derive/eqcorrect.vo: elpi/eqcorrect.elpi theories/derive/eqOK.vo: elpi/eqOK.elpi theories/derive/induction.vo: elpi/induction.elpi theories/derive/map.vo: elpi/map.elpi theories/derive/param1_inhab.vo: elpi/param1_inhab.elpi theories/derive/param2.vo: elpi/param2.elpi elpi/paramX-lib.elpi theories/derive/lens.vo: elpi/lens.elpi theories/derive/lens_laws.vo: elpi/lens_laws.elpi coverage: @for F in $(wildcard theories/derive/*.v); do\ D=`basename $$F .v`;\ T="tests/test_$${D}.v";\ N=`grep -E "^(Fail )?Elpi derive.$$D" $$T 2>/dev/null| wc -l`;\ OK=`grep -E "^Elpi derive.$$D" $$T 2>/dev/null| wc -l`;\ printf "====== %-10s (%2d/%-2d)\n" $$D $$OK $$N;\ grep -E "^Fail Elpi derive.$$D" $$T 2>/dev/null;\ done || true coq-elpi-1.13.0/apps/derive/README.md000066400000000000000000000277641420046334000170210ustar00rootroot00000000000000# 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. derive Inductive peano := Zero | Succ (p : peano). Print peano. (* Inductive peano : Type := Zero : peano | Succ : peano -> peano *) Eval compute in peano.eq Zero (Succ Zero). (* = false : bool *) About peano.eq_OK. (* peano.eq_OK : forall s1 s2, reflect (s1 = s2) (peano.eq s1 s2) *) ``` See also [examples/usage.v](examples/usage.v) ## Documentation 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/`. 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. 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 ### `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). ``` ### `map` Map a container over its parameters. ```coq Elpi derive.map list. Check list_map : forall A B, (A -> B) -> list A -> list B. ``` ### `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_inhab` ```coq Elpi derive.param1.inhab is_nat. Check nat_is_nat : forall x : nat, is_nat x. ``` ### `param1_congr` ```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. ``` ### `param1_trivial` ```coq Elpi derive.param1.trivial is_nat. Check is_nat_trivial : forall x : nat, { p : is_nat x & forall q, p = q }. ``` ### `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. ``` ### `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). ``` ### `lens` See also [theories/derive/lens.v](theories/derive/lens.v) for the `Lens` definition and the support constants `view`, `set` and `over`. ```coq 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. ``` ## 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: | coq-elpi-1.13.0/apps/derive/_CoqProject000066400000000000000000000012671420046334000176630ustar00rootroot00000000000000# 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 theories/derive.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_inhab.v theories/derive/param1_trivial.v theories/derive/param2.v theories/derive/induction.v theories/derive/lens.v theories/derive/lens_laws.v coq-elpi-1.13.0/apps/derive/_CoqProject.test000066400000000000000000000012141420046334000206310ustar00rootroot00000000000000# 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_inhab.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 examples/usage.vcoq-elpi-1.13.0/apps/derive/derive.svg000066400000000000000000001620751420046334000175340ustar00rootroot00000000000000 image/svg+xml eqOK induction eqK eq param1 projK bcongr injection isK discriminate eqcorrect param1functor param1congr param1inhab param1trivial coq-elpi-1.13.0/apps/derive/elpi/000077500000000000000000000000001420046334000164535ustar00rootroot00000000000000coq-elpi-1.13.0/apps/derive/elpi/bcongr.elpi000066400000000000000000000113141420046334000206000ustar00rootroot00000000000000 /* 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 ^ {coq.gref->id (indc K)}, coq.env.add-const Name 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.13.0/apps/derive/elpi/cast.elpi000066400000000000000000000035731420046334000202700ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/derive.elpi000066400000000000000000000115721420046334000206120ustar00rootroot00000000000000/* Entry point for all derivations */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive { pred if-verbose i:prop. if-verbose P :- get-option "verbose" tt, !, P. if-verbose _. kind derive type. type derive string -> (A -> prop) -> derive. pred dep o:string, o:string. dep X Y :- dep1 X Y. dep X Y :- dep1 X Z, dep Z Y. pred dep1 o:string, o:string. dep1 "lens_laws" "lens". dep1 "eqOK" "eqcorrect". dep1 "eqOK" "param1_trivial". dep1 "param1_trivial" "param1_inhab". dep1 "param1_trivial" "param1_congr". dep1 "param1_congr" "param1". dep1 "param1_trivial" "param1". dep1 "param1_functor" "param1". dep1 "eqcorrect" "induction". dep1 "eqcorrect" "eq". dep1 "eqcorrect" "eqK". dep1 "induction" "param1_functor". dep1 "induction" "param1_functor". dep1 "eqK" "bcongr". dep1 "eqK" "isK". dep1 "bcongr" "projK". dep1 "idx2inv" "invert". dep1 "eq_param1" "eq". pred selected i:string. selected Name :- get-option "only" Map, !, Map => (get-option Name _; (get-option X _, dep X Name)). selected _. pred chain i:list derive. chain []. chain [derive Name _|FS] :- not(selected Name), !, if-verbose (coq.say "Skipping derivation" Name), chain FS. chain [derive Name F|FS] :- if-verbose (coq.say "Derivation" Name), (pi x\ stop x :- !, fail) => F C, !, C => chain FS. chain [derive F _|FS] :- if-verbose (coq.say "Derivation" F "failed"), chain FS. pred on_param1 i:inductive, i:(inductive -> string -> list prop -> prop), i:string, o:list prop. on_param1 T F N C :- reali (global (indt T)) (global (indt P)), !, F P N C. pred on_eq i:inductive, i:(constant -> string -> list prop -> prop), i:string, o:list prop. on_eq T F N X :- eq-for T C, !, F C N X. pred main i:inductive, i:string. main T Prefix :- chain [ derive "isK" (derive.isK.main T {calc (Prefix ^ "isk_")}), derive "map" (derive.map.main T {calc (Prefix ^ "map")}), derive "projK" (derive.projK.main T {calc (Prefix ^ "getk_")}), derive "param1" (derive.param1.main (indt T) {calc (Prefix ^ "is_")}), derive "param1_congr" (on_param1 T derive.param1.congr.main "congr_"), derive "param1_inhab" (on_param1 T derive.param1.inhab.main "_full"), derive "param1_trivial" (on_param1 T derive.param1.trivial.main "_trivial"), derive "param1_functor" (on_param1 T derive.param1.functor.main "_functor"), derive "induction" (derive.induction.main T {calc (Prefix ^ "induction")}), derive "eq" (derive.eq.main T {calc (Prefix ^ "eq")}), derive "eq_param1" (on_eq T (x\derive.param1.main (const x)) {calc (Prefix ^ "param1_")}), derive "bcongr" (derive.bcongr.main T {calc (Prefix ^ "bcongr_")}), derive "eqK" (derive.eqK.main T {calc (Prefix ^ "eq_axiom_")}), derive "eqcorrect" (derive.eqcorrect.main T {calc (Prefix ^ "eq_correct")}), derive "eqOK" (derive.eqOK.main T {calc (Prefix ^ "eq_OK")}), derive "param2" (derive.param2.main (indt T) {calc (Prefix ^ "_R")}), derive "invert" (derive.invert.main T {calc (Prefix ^ "inv")}), derive "idx2inv" (derive.idx2inv.main T "_to_"), derive "lens" (derive.lens.main T {calc (Prefix ^ "_")}), derive "lens_laws" (derive.lens-laws.main T {calc (Prefix ^ "_")}), ]. 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 I "", 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) (coq.arguments.set-implicit (indt I) [IndImpls]) true, std.forall2 KsImpls KS (i\k\ if (coq.any-implicit? i) (coq.arguments.set-implicit (indc k) [i]) true ), ]. 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.13.0/apps/derive/elpi/discriminate.elpi000066400000000000000000000024461420046334000220070ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/eq.elpi000066400000000000000000000155061420046334000177420ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/eqK.elpi000066400000000000000000000074631420046334000200600ustar00rootroot00000000000000/* 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, !, 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 _ _, !, 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.13.0/apps/derive/elpi/eqOK.elpi000066400000000000000000000027441420046334000201740ustar00rootroot00000000000000/* 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 [] :- 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-1.13.0/apps/derive/elpi/eqcorrect.elpi000066400000000000000000000114341420046334000213200ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/idx2inv.elpi000066400000000000000000000064361420046334000207220ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/induction.elpi000066400000000000000000000122321420046334000213220ustar00rootroot00000000000000/* 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 Name [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", coq.env.add-const Name 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.13.0/apps/derive/elpi/injection.elpi000066400000000000000000000040071420046334000213110ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/invert.elpi000066400000000000000000000071061420046334000206410ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/isK.elpi000066400000000000000000000030371420046334000200570ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/lens.elpi000066400000000000000000000067151420046334000203000ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/lens_laws.elpi000066400000000000000000000110501420046334000213120ustar00rootroot00000000000000/* 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 [] :- 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-1.13.0/apps/derive/elpi/map.elpi000066400000000000000000000153641420046334000201140ustar00rootroot00000000000000/* 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 Name 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", 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)) Clause, coq.elpi.accumulate _ "derive.map.db" (clause _ _ Clause), C = [Clause] ]. } coq-elpi-1.13.0/apps/derive/elpi/param1.elpi000066400000000000000000000155621420046334000205200ustar00rootroot00000000000000/* 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.env.add-const Nreali 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 [V] 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.env.add-const Name 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), Clauses = [C1, C2] ]. 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.build-indt-decl (pr new_name NewName) 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 _, forall2 Knames RealNamesR (reali-store-indc NewName), 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)), Clauses = [C1,C2|CK] ]. dispatch (indc _) _ _ :- coq.error "derive.param1: cannot translate a constructor". pred main i:gref, i:string, o:list prop. main T Out Clauses :- dispatch T Out 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.13.0/apps/derive/elpi/param1_congr.elpi000066400000000000000000000045561420046334000217110ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/param1_functor.elpi000066400000000000000000000202441420046334000222510ustar00rootroot00000000000000/* 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 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 :- param1-functor-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 (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 bo-params Lno Lno Ity1 Ity2 A1 _ Ps (fix `f` Recno Fty Bo) :- !, @pi-decl `rec` Fty f\ param1-functor-db Ity1 Ity2 f => bo-idx A1 Ity1 Ity2 0 Recno Ps (Bo f) Fty. bo-params N Lno Ity1 Ity2 (prod A Sty1 Rty1) (prod _ _ Rty2) Ps R :- skip N, !, 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, param1-functor-db a a {{ fun x : lp:a => x }} => decl a A Sty1 => bo-params N1 Lno Ity1A Ity2A (Rty1 a) (Rty2 a) [a|Ps] (Bo a). 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). 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. % clause for param1-functor-db mk-clause N N Ity1 Ity2 _ Todo Map (param1-functor-db Ity1 Ity2 Map :- Todo). mk-clause N Lno Ity1 Ity2 (prod _ _ T) Todo Map (pi x\ C x) :- skip N, !, 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). 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) [param1-functor-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. % We want to know if a parameter occurs in the type of an index %%%%%%%%%%%%% pred skip-analysis i:int, % current parameter i:int, % number of parameters i:term, % arity of the inductive i:list (pair term int), % parameters bound so far and their position o:list prop. % made of skip skip-analysis N P T L S :- whd1 T T1, !, skip-analysis N P T1 L S. skip-analysis N N Arity Params ToSkip :- !, skip-analysis.aux Params Arity ToSkip. skip-analysis N P (prod _ _ T) Params ToSkip :- !, M is N + 1, pi x\ skip-analysis M P (T x) [pr x N|Params] ToSkip. skip-analysis.aux [] _ []. skip-analysis.aux [pr V N|Params] Arity ToSkip :- if (occurs V Arity) (ToSkip = [skip N|ToSkip1]) (ToSkip = ToSkip1), skip-analysis.aux Params Arity ToSkip1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 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", % we pre compute the list of parameters that we won't map skip-analysis 0 Lno Arity [] SkipList, % generate map and add to the env T = global (indt GR), SkipList => 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 SkipList => mk-clause 0 Lno T T Arity [] (global (const Funct)) Clause, coq.elpi.accumulate _ "derive.param1.functor.db" (clause _ _ Clause), C = [Clause] ]. } coq-elpi-1.13.0/apps/derive/elpi/param1_inhab.elpi000066400000000000000000000110231420046334000216450ustar00rootroot00000000000000/* 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 N T x\ prod NX (PX x) (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 @pi-decl N T x\ @pi-decl NX (PX x) px\ prove-args VS (F x px) 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 : full 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, !, 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 _ 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] :- 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.inhab.db" (clause _ _ ClauseW) ]. } % vim:set ft=lprolog spelllang=: coq-elpi-1.13.0/apps/derive/elpi/param1_trivial.elpi000066400000000000000000000102541420046334000222430ustar00rootroot00000000000000/* 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 :- coq.safe-dest-app K (global (indc Kname)) Params, assert! (param1-congr-db Kname CongrK) "run derive.param1.congr first", coq.mk-app CongrK Params Rhd, prove-args V VT P, coq.mk-app Rhd P R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred body-params i:int, % number of params left i:term, % inductive type applied to parameters treated so far i:term, % inhabitation witness applied to parameters treated so far i:term, % inductive type arity to process o:term. body-params 0 IsT W (prod _ T _\ sort _) R :- !, 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 W (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\ 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) body-params M {coq.mk-app T [a,p]} {coq.mk-app W [a,p,{{ lib:elpi.derive.trivial_full lp:a lp:p lp:pf }} ]} (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] :- do! [ coq.env.indt GR _ Lno _ Arity _ _, assert! (param1-inhab-db (global (indt GR)) Witness) "run derive.param1_inhab first", body-params Lno (global (indt GR)) Witness 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) ]. } % main IsT Prefix [ClauseW] :- do! [ % % The input is T is the param1 translation of an inductive type % assert (IsT = indt GR) "derive.param1_trivial: not an inductive type", % Name_aux is Prefix ^ {coq.gref->id GR} ^ "_witness", % Name is Prefix ^ {coq.gref->id GR}, % % inhab.main GR Name_aux W, % ClauseW = (param1P-db IsT W), % coq.elpi.accumulate _ "derive.param1_trivial.db" (clause _ _ ClauseW), % % congr.main GR ClausesCongr, % forall ClausesCongr % (x\ coq.elpi.accumulate _ "derive.param1_trivial.db" (clause _ _ x)), % ( % (ClauseW => ClausesCongr => unique.main GR Name W Cst, % Clause = (param1P-db-trivial IsT Cst), % coq.elpi.accumulate _ "derive.param1_trivial.db" (clause _ _ Clause) ) ; fail ) % ]. % % } % vim:set ft=lprolog spelllang=: coq-elpi-1.13.0/apps/derive/elpi/param2.elpi000066400000000000000000000177331420046334000205230ustar00rootroot00000000000000/* 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.env.add-const Nparam 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.env.add-const NameR 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), Clauses = [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, 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 NameR) 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)), Clauses = [C1,C2|CK] ]. dispatch (indc _) _ _ :- coq.error "derive.param2: cannot translate a constructor". pred main i:gref, i:string, o:list prop. main T Out Clauses :- dispatch T Out 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.13.0/apps/derive/elpi/paramX-lib.elpi000066400000000000000000000055011420046334000213230ustar00rootroot00000000000000/* 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.13.0/apps/derive/elpi/projK.elpi000066400000000000000000000126401420046334000204160ustar00rootroot00000000000000/* 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) (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.13.0/apps/derive/examples/000077500000000000000000000000001420046334000173405ustar00rootroot00000000000000coq-elpi-1.13.0/apps/derive/examples/usage.v000066400000000000000000000047631420046334000206450ustar00rootroot00000000000000(** This example shows how to use derive *) From elpi.apps Require Import derive. (** The basic invocation is with just one argument, the inductive type name *) derive nat. (** generated constants are prefixed with nat_ *) Check nat_eq_OK : forall x y, reflect (x = y) (nat_eq x y). (** One can also prefix an Inductive declaration with derive. *) derive Inductive tickle A := stop | more : A -> tickle -> tickle. (** In this case the command is elaborated 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. *) Check more : forall A, A -> tickle A -> tickle A. (** Some goodies *) Check tickle.eq : (* eq test *) forall A, (A -> A -> bool) -> tickle A -> tickle A -> bool. Check tickle.eq_OK : (* eq test correctness proof *) forall A f, (forall x y, reflect (x = y) (f x y)) -> forall x y, reflect (x = y) (tickle.eq A f x y). Check tickle.map : (* map the container *) forall A B, (A -> B) -> tickle A -> tickle B. Check tickle.isk_stop : (* recognize a constructor *) forall A, tickle A -> bool. 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. Check rtree.eq_OK nat nat_eq nat_eq_OK : (* proofs compose *) forall x y : rtree nat, reflect (x = y) (rtree.eq nat nat_eq x y). (** You can also select which derivations you like *) #[only(lens_laws, eq)] derive Record Box A := { contents : A; tag : nat }. Check Box.eq : forall A, (A -> A -> bool) -> Box A -> Box A -> bool. 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). coq-elpi-1.13.0/apps/derive/tests/000077500000000000000000000000001420046334000166645ustar00rootroot00000000000000coq-elpi-1.13.0/apps/derive/tests/test_bcongr.v000066400000000000000000000066071420046334000213750ustar00rootroot00000000000000From 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 rose. 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. 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.13.0/apps/derive/tests/test_derive.v000066400000000000000000000135731420046334000214010ustar00rootroot00000000000000From elpi.apps Require Import derive. 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.rose. 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. Elpi derive nat. Check nat_eq : nat -> nat -> bool. Check nat_is_nat : nat -> Type. Check nat_param1_nat_eq : forall x1 : nat, nat_is_nat x1 -> forall x2 : nat, nat_is_nat x2 -> bool_is_bool (nat_eq x1 x2). Check nat_isk_O : nat -> bool. Check nat_isk_S : nat -> bool. Check nat_getk_S1 : nat -> nat -> nat. Check nat_is_O : nat_is_nat O. Check nat_is_S : forall x, nat_is_nat x -> nat_is_nat (S x). Check nat_is_nat_full : forall x, nat_is_nat x. Check nat_is_nat_functor : forall x, nat_is_nat x -> nat_is_nat x. Check nat_induction : forall P, P 0 -> (forall n, P n -> P (S n)) -> forall x, nat_is_nat x -> P x. (* ---------------------------------------------------- *) Elpi derive.param1 andb. Elpi derive list. Check list_eq : forall A, (A -> A -> bool) -> list A -> list A -> bool. Check list_isk_nil : forall A, list A -> bool. Check list_isk_cons : forall A, list A -> bool. Check list_map : forall A B, (A -> B) -> list A -> list B. Check list_getk_cons1 : forall A, A -> list A -> list A -> A. Check list_getk_cons2 : forall A, A -> list A -> list A -> list A. Check list_is_nil : forall A P, list_is_list A P (@nil A). Check list_is_cons : forall A P x (Px : P x) tl (Ptl : list_is_list A P tl), list_is_list A P (cons x tl). Check list_is_list_functor : forall A P Q, (forall x, P x -> Q x) -> forall l, list_is_list A P l -> list_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, list_is_list A PA l -> P l. Check list_param1_list_eq : forall A (PA : A -> Type), forall f, (forall a, PA a -> forall b, PA b -> bool_is_bool (f a b)) -> forall x, list_is_list A PA x -> forall y, list_is_list A PA y -> bool_is_bool (list_eq A f x y). (* ---------------------------------------------------- *) Require Vector. Elpi derive Vector.t Vector_. Check Vector_eq : forall A, (A -> A -> bool) -> forall n, Vector.t A n -> Vector.t A n -> bool. Check Vector_isk_nil : forall A n, Vector.t A n -> bool. Check Vector_isk_cons : forall A n, Vector.t A n -> bool. Check Vector_map : forall A B, (A -> B) -> forall n, Vector.t A n -> Vector.t B n. Check Vector_getk_cons1 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> A. Check Vector_getk_cons2 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> nat. Check Vector_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, nat_is_nat n -> Vector.t A n -> Type. Check Vector_is_nil : forall A (PA : A -> Type), Vector_is_t A PA 0 nat_is_O (Vector.nil A). Check Vector_is_cons : forall A (PA : A -> Type) (a : A), PA a -> forall n (Pn : nat_is_nat n) (H : Vector.t A n), Vector_is_t A PA n Pn H -> Vector_is_t A PA (S n) (nat_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_induction : forall A PA (P : forall n, nat_is_nat n -> Vector.t A n -> Type), P 0 nat_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) (nat_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. (* ---------------------------------------------------- *) Inductive W A := B (f : A -> W A). 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. (* ---------------------------------------------------- *) Inductive horror A (a : A) : forall T, T -> Type := K W w (k : horror A a W w) : horror A a W w. Elpi derive horror. Fail Check horror_induction : forall A a (P : forall T t, horror A a T t -> Type), (forall W (_: UnitPred Type W) w (_: UnitPred _ w) (k : horror A a W w), P W w k -> P W w (K A a W w k)) -> forall T t (x : horror A a T t), P T t x. (* ---------------------------------------------------- *) Inductive rtree A : Type := Leaf (n : A) | Node (l : list (rtree A)). Elpi derive rtree XXX. Fail Check XXX_is_rtree_map. (* 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, unit_is_unit H -> triv H -> Prop), (forall t (Pt : unit_is_unit t), P t Pt (one t)) -> (forall x (Px : unit_is_unit x), P x Px (more x)) -> forall u (p : unit_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 list_is_list. derive Inductive Pred : RoseTree -> Type := | Pred_ctr branches : list_is_list _ Pred branches -> Pred (RT_ctr branches). Check Pred.Pred_to_Predinv : forall T, Pred T -> Pred.Predinv T. (* #286 *) derive Inductive wimpls {A} `{rtree A} := Kwi (x:A) (y : x = x) : wimpls | Kwa. About wimpls.wimpls. About wimpls.Kwi. Check Kwi _ (refl_equal 3). coq-elpi-1.13.0/apps/derive/tests/test_derive_stdlib.v000066400000000000000000000125431420046334000227360ustar00rootroot00000000000000(* Some standard data types using different features *) From Coq Require Int63. 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 rose (A : Type) := Leaf (a : A) | 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) | 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 : Int63.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. End Coverage. coq-elpi-1.13.0/apps/derive/tests/test_derive_vector.v000066400000000000000000000105561420046334000227610ustar00rootroot00000000000000From 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.13.0/apps/derive/tests/test_eq.v000066400000000000000000000032131420046334000205160ustar00rootroot00000000000000From 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 rose. Fail Elpi derive.eq nest. Fail Elpi derive.eq w. Elpi derive.eq vect. Fail Elpi derive.eq dyn. 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. 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.13.0/apps/derive/tests/test_eqK.v000066400000000000000000000053641420046334000206420ustar00rootroot00000000000000From 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 rose. 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. 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.13.0/apps/derive/tests/test_eqOK.v000066400000000000000000000052361420046334000207570ustar00rootroot00000000000000From elpi.apps Require Import derive.eqOK. From elpi.apps Require Import test_derive_stdlib test_eqcorrect test_param1 test_param1_inhab test_param1_trivial. Import test_derive_stdlib.Coverage. Import tests.test_eq.Coverage. Import test_eqcorrect.Coverage. Import test_param1.Coverage. Import test_param1_inhab.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 rose. 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. End Coverage. Import Coverage. 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. Module OtherTests. Import test_param1_functor.Coverage. Inductive dlist A := dnil | dcons (a : pair A peano) (l : dlist A). Elpi derive.param1 dlist. Elpi derive.param1.inhab 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.13.0/apps/derive/tests/test_eqcorrect.v000066400000000000000000000050521420046334000221030ustar00rootroot00000000000000From 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 rose. 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. End Coverage. Import Coverage. 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.13.0/apps/derive/tests/test_idx2inv.v000066400000000000000000000004301420046334000214720ustar00rootroot00000000000000From elpi.apps Require Import derive.param1 derive.param1_inhab 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.13.0/apps/derive/tests/test_induction.v000066400000000000000000000066511420046334000221160ustar00rootroot00000000000000From 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 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 rose. 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. 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.coq-elpi-1.13.0/apps/derive/tests/test_invert.v000066400000000000000000000011031420046334000214140ustar00rootroot00000000000000From elpi.apps Require Import derive.invert. Inductive test A : bool -> Type := K1 : test A true | K2 : forall x, A -> test A (negb x) -> test A (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 A PA (@nil A) | consR : forall a : A, PA a -> forall xs : list A, listR A PA xs -> listR A PA (cons a xs). Elpi derive.invert listR.coq-elpi-1.13.0/apps/derive/tests/test_isK.v000066400000000000000000000034741420046334000206500ustar00rootroot00000000000000From 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 rose. 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. 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.13.0/apps/derive/tests/test_lens.v000066400000000000000000000015411420046334000210540ustar00rootroot00000000000000From 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. 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.13.0/apps/derive/tests/test_lens_laws.v000066400000000000000000000027011420046334000221010ustar00rootroot00000000000000 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. 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.13.0/apps/derive/tests/test_map.v000066400000000000000000000027411420046334000206730ustar00rootroot00000000000000From 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 rose. 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. 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.13.0/apps/derive/tests/test_param1.v000066400000000000000000000111021420046334000212660ustar00rootroot00000000000000From 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 rose. 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. 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. End Test. (* other tests by Cyril *) 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 A 0 | vcons : A -> forall n : nat, vec A n -> vec A (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.13.0/apps/derive/tests/test_param1_congr.v000066400000000000000000000056221420046334000224700ustar00rootroot00000000000000From 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_nest. Elpi derive.param1.congr is_rose. 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. *) 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. 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.13.0/apps/derive/tests/test_param1_functor.v000066400000000000000000000044741420046334000230440ustar00rootroot00000000000000From 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_rose. 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. 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. coq-elpi-1.13.0/apps/derive/tests/test_param1_inhab.v000066400000000000000000000045001420046334000224330ustar00rootroot00000000000000From elpi.apps Require Import derive.param1_inhab. From elpi.apps Require Import test_derive_stdlib test_param1. Import test_derive_stdlib.Coverage. Import test_param1.Coverage. Module Coverage. Elpi derive.param1.inhab is_empty. Elpi derive.param1.inhab is_unit. Elpi derive.param1.inhab is_peano. Elpi derive.param1.inhab is_option. Elpi derive.param1.inhab is_pair. Elpi derive.param1.inhab is_seq. Fail Elpi derive.param1.inhab is_nest. Elpi derive.param1.inhab is_rose. Elpi derive.param1.inhab is_w. Fail Elpi derive.param1.inhab is_vect. Fail Elpi derive.param1.inhab is_dyn. Elpi derive.param1.inhab is_zeta. Elpi derive.param1.inhab is_beta. Fail Elpi derive.param1.inhab is_iota. Elpi derive.param1.inhab is_large. Elpi derive.param1.inhab is_prim_int. Elpi derive.param1.inhab is_prim_float. Elpi derive.param1.inhab is_fo_record. Elpi derive.param1.inhab is_pa_record. Elpi derive.param1.inhab is_pr_record. Fail Elpi derive.param1.inhab is_dep_record. Elpi derive.param1.inhab is_enum. End Coverage. Import Coverage. Check is_empty_witness : full empty is_empty. Check is_unit_witness : full unit is_unit. Check is_peano_witness : full peano is_peano. Check is_option_witness : forall A P, full A P -> full (option A) (is_option A P). Check is_pair_witness : 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_witness : forall A P, full A P -> full (seq A) (is_seq A P). Check is_rose_witness : forall A P, full A P -> full (rose A) (is_rose A P). Fail Check is_nest_witness. Check is_w_witness : forall A P, full A P -> full (w A) (is_w A P). Fail Check is_vect_witness : forall A P, full A P -> forall i pi, full (vect A i) (is_vect A P i pi). Fail Check is_dyn_witness. Check is_zeta_witness : forall A P, full A P -> full (zeta A) (is_zeta A P). Check is_beta_witness : forall A P, full A P -> full (beta A) (is_beta A P). Fail Check is_iota_witness. Check is_large_witness : full large is_large. Check is_prim_int_witness : full prim_int is_prim_int. Check is_prim_float_witness : full prim_float is_prim_float. Check is_fo_record_witness : full fo_record is_fo_record. Check is_pa_record_witness : forall A P, full A P -> full (pa_record A) (is_pa_record A P). Check is_pr_record_witness : forall A P, full A P -> full (pr_record A) (is_pr_record A P). Check is_enum_witness : full enum is_enum.coq-elpi-1.13.0/apps/derive/tests/test_param1_trivial.v000066400000000000000000000051021420046334000230230ustar00rootroot00000000000000From elpi.apps Require Import derive.param1_trivial. From elpi.apps Require Import test_derive_stdlib test_param1 test_param1_inhab test_param1_congr. Import test_derive_stdlib.Coverage. Import test_param1.Coverage. Import test_param1_inhab.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. Fail Elpi derive.param1.trivial is_nest. Elpi derive.param1.trivial is_rose. 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. Fail 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. 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. Fail 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. coq-elpi-1.13.0/apps/derive/tests/test_param2.v000066400000000000000000000047271420046334000213060ustar00rootroot00000000000000From elpi.apps Require Import derive.param2. Elpi derive.param2 unit R. Elpi derive.param2 nat R. Elpi derive.param2 list R. (* 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 R. Print nthR. Inductive fin : nat -> Type := FO : fin 0 | FS : forall n : nat, fin n -> fin (S n). Elpi derive.param2 fin R. Fixpoint fin_length n (v : fin n) := match v with FO => 0 | FS _ w => S (fin_length _ w) end. Elpi derive.param2 fin_length R. Inductive vec (A : Type) : nat -> Type := vnil : vec A 0 | vcons : A -> forall n : nat, vec A n -> vec A (S n). Elpi derive.param2 vec R. 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 R. Elpi derive.param2 eq R. Elpi derive.param2 listR R. Fixpoint plus' m n := match n with 0 => m | S n => S (plus' m n) end. Elpi derive.param2 plus' R. Elpi derive.param2 plus R. Elpi derive.param2 prod R. Elpi derive.param2 fst R. Elpi derive.param2 snd R. Elpi derive.param2 Nat.divmod R. Elpi derive.param2 Nat.div R. Definition test m n p q r := m + n + p + q + r. Elpi derive.param2 test R. Definition vec_length_type := forall (A : Type) (n : nat), vec A n -> nat. Elpi derive.param2 vec_length_type R. 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 R. Definition nat2nat := nat -> nat. Definition nat2nat2nat := nat -> nat -> nat. Elpi derive.param2 nat2nat R. Elpi derive.param2 nat2nat2nat R. Elpi derive.param2 pred R. Print predR. Check (predR : nat2natR pred pred). Fixpoint predn n := match n with 0 => 0 | S n => S (predn n) end. Elpi derive.param2 predn R. Check (prednR : nat2natR predn predn). Check (addR : nat2nat2natR plus plus). Fixpoint quasidn n m := S (match n with 0 => m | S n => S (quasidn n m) end). Elpi derive.param2 quasidn R. Fixpoint weirdn n := match n with S (S n) => S (weirdn n) | _ => 0 end. Elpi derive.param2 weirdn R. Inductive bla : nat -> Type := Bla : nat -> bla 0 | Blu n : bla n -> bla 1. Elpi derive.param2 bla R. Fixpoint silly (n : nat) := n. Elpi derive.param2 silly R. coq-elpi-1.13.0/apps/derive/tests/test_projK.v000066400000000000000000000052171420046334000212040ustar00rootroot00000000000000From 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 rose. 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. 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.13.0/apps/derive/theories/000077500000000000000000000000001420046334000173445ustar00rootroot00000000000000coq-elpi-1.13.0/apps/derive/theories/derive.v000066400000000000000000000122741420046334000210170ustar00rootroot00000000000000(* Generates a module containing all the derived constants. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) (** 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 Require Export derive.eq derive.isK derive.map derive.projK derive.param1 derive.param1_congr derive.param1_inhab derive.param1_trivial derive.invert derive.idx2inv derive.induction derive.bcongr derive.eqK derive.eqcorrect derive.eqOK derive.param2 derive.lens derive.lens_laws . Elpi Command derive. Elpi Accumulate Db derive.eq.db. Elpi Accumulate File "eq.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File "isK.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.map.db. Elpi Accumulate File "map.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File "projK.elpi" From elpi.apps.derive. Elpi Accumulate File "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate File "param1.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File "param1_functor.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate File "param1_congr.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.inhab.db. Elpi Accumulate File "param1_inhab.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate File "param1_trivial.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.invert.db. Elpi Accumulate File "invert.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.idx2inv.db. Elpi Accumulate File "idx2inv.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.induction.db. Elpi Accumulate File "induction.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.bcongr.db. Elpi Accumulate File "injection.elpi" From elpi.apps.derive. Elpi Accumulate File "bcongr.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.eqK.db. Elpi Accumulate File "discriminate.elpi" From elpi.apps.derive. Elpi Accumulate File "eqK.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.eqcorrect.db. Elpi Accumulate File "eqcorrect.elpi" From elpi.apps.derive. Elpi Accumulate File "eqOK.elpi" From elpi.apps.derive. Elpi Accumulate File "param2.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param2.db. Elpi Accumulate File "lens.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.lens.db. Elpi Accumulate File "lens_laws.elpi" From elpi.apps.derive. Elpi Accumulate File "derive.elpi" From elpi.apps.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, ] Opts, !, Opts => P. main [str I, str Prefix] :- !, coq.locate I (indt GR), with-attributes (derive.main GR Prefix). main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Prefix is Tname ^ "_", with-attributes (derive.main GR Prefix). 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. (* we derive the Coq prelude *) Module Prelude. Module Empty_set. derive Init.Datatypes.Empty_set "". End Empty_set. Module unit. derive Init.Datatypes.unit "". End unit. Module bool. derive Init.Datatypes.bool "". End bool. Module nat. derive Init.Datatypes.nat "". End nat. Module option. derive Init.Datatypes.option "". End option. Module sum. derive Init.Datatypes.sum "". End sum. Module prod. derive Init.Datatypes.prod "". End prod. Module list. derive Init.Datatypes.list "". End list. Module comparison. derive Init.Datatypes.comparison "". End comparison. End Prelude. Export Prelude. coq-elpi-1.13.0/apps/derive/theories/derive/000077500000000000000000000000001420046334000206225ustar00rootroot00000000000000coq-elpi-1.13.0/apps/derive/theories/derive/bcongr.v000066400000000000000000000024771420046334000222750ustar00rootroot00000000000000(* Generates congruence lemmas using reflect license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From Coq Require Export Bool. From elpi Require Export elpi. 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. }}. Elpi Command derive.bcongr. Elpi Accumulate Db derive.bcongr.db. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File "injection.elpi" From elpi.apps.derive. Elpi Accumulate File "bcongr.elpi" From elpi.apps.derive. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.bcongr.main GR O _. main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Name is Tname ^ "_bcongr_", derive.bcongr.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.bcongr []". }}. Elpi Typecheck. coq-elpi-1.13.0/apps/derive/theories/derive/cast.v000066400000000000000000000012001420046334000217340ustar00rootroot00000000000000(* Generates (once and forall) cast operators (trasport). license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) 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" From elpi.apps.derive. 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.13.0/apps/derive/theories/derive/eq.v000066400000000000000000000027311420046334000214210ustar00rootroot00000000000000(* Generates equality tests. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From Coq Require Export Bool. From elpi Require Export elpi. 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 Db derive.eq.db. Elpi Accumulate File "eq.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/eqK.v000066400000000000000000000033351420046334000215350ustar00rootroot00000000000000(* 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 Require Export elpi. From elpi.apps Require Export 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. }}. Elpi Command derive.eqK. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File "discriminate.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.bcongr.db. Elpi Accumulate Db derive.eq.db. Elpi Accumulate Db derive.eqK.db. Elpi Accumulate File "eqK.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/eqOK.v000066400000000000000000000021721420046334000216520ustar00rootroot00000000000000(* Generates the final, correctness lemma, for equality tests by combinig the output of eqcorrect and param1_witness. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. From elpi.apps Require Export derive.param1 derive.param1_inhab derive.param1_trivial derive.eqK derive.eqcorrect. Elpi Command derive.eqOK. Elpi Accumulate File "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate File "param1.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.inhab.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate Db derive.eqcorrect.db. Elpi Accumulate File "eqOK.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/eqOK_trivial.v000066400000000000000000000030471420046334000234060ustar00rootroot00000000000000(* 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.13.0/apps/derive/theories/derive/eqcorrect.v000066400000000000000000000035161420046334000230050ustar00rootroot00000000000000(* Generates correctness proofs for comparison functions generated by derive.eq. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. From elpi.apps Require Export derive.eq derive.map derive.induction derive.eqK. From Coq Require Import ssreflect Int63. Lemma uint63_eq_correct i : is_uint63 i -> eq_axiom_at PrimInt63.int PrimInt63.eqb i. Proof. move=> _ j; case: (Int63.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. }}. 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" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/idx2inv.v000066400000000000000000000022331420046334000223740ustar00rootroot00000000000000(* 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 Require Export elpi. 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. }}. Elpi Command derive.idx2inv. Elpi Accumulate File "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File "param1_functor.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.invert.db. Elpi Accumulate Db derive.idx2inv.db. Elpi Accumulate File "idx2inv.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/induction.v000066400000000000000000000023301420046334000230030ustar00rootroot00000000000000(* Generates the induction principle. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. From elpi.apps Require Export derive.param1 derive.param1_functor. Elpi Db derive.induction.db lp:{{ type induction-db inductive -> term -> prop. :name "induction-db:fail" induction-db T _ :- M is "derive.induction: can't find the induction principle for " ^ {std.any->string T}, stop M. }}. Elpi Command derive.induction. Elpi Accumulate File "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate File "param1.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate Db derive.induction.db. Elpi Accumulate File "induction.elpi" From elpi.apps.derive. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.induction.main GR O _. main [str I] :- !, coq.locate I (indt GR), Name is {coq.gref->id (indt GR)} ^ "_induction", derive.induction.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.induction []". }}. Elpi Typecheck. coq-elpi-1.13.0/apps/derive/theories/derive/invert.v000066400000000000000000000014211420046334000223160ustar00rootroot00000000000000(* 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 Require Export elpi. 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" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/isK.v000066400000000000000000000020671420046334000215440ustar00rootroot00000000000000(* 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 Require Export elpi. (* 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 Db derive.isK.db. Elpi Accumulate File "isK.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/lens.v000066400000000000000000000023031420046334000217500ustar00rootroot00000000000000(* A lens, to see better. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. (* 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. Elpi Db derive.lens.db lp:{{ pred lens-db o:inductive, o:string, o:constant. }}. Elpi Command derive.lens. Elpi Accumulate File "lens.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/lens_laws.v000066400000000000000000000034641420046334000230070ustar00rootroot00000000000000(* Equations for lenses license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. From elpi.apps Require Export 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 Command derive.lens_laws. Elpi Accumulate File "lens_laws.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.lens.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. coq-elpi-1.13.0/apps/derive/theories/derive/map.v000066400000000000000000000016311420046334000215670ustar00rootroot00000000000000(* 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 Require Export elpi. (* 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:{{ type map-db term -> term -> term -> prop. }}. Elpi Command derive.map. Elpi Accumulate Db derive.map.db. Elpi Accumulate File "map.elpi" From elpi.apps.derive. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.map.main GR O _. main [str I] :- !, coq.locate I (indt GR), O is {coq.gref->id (indt GR)} ^ "_map", derive.map.main GR O _. main _ :- usage. usage :- coq.error "Usage: derive.map []". }}. Elpi Typecheck. coq-elpi-1.13.0/apps/derive/theories/derive/param1.v000066400000000000000000000053301420046334000221730ustar00rootroot00000000000000(* Unary parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. 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:{{ :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. }}. Elpi Command derive.param1. Elpi Accumulate File "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate File "param1.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.db. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I GR, derive.param1.main GR O _. main [str I] :- !, coq.locate I GR, derive.param1.main GR "is_" _. main _ :- usage. usage :- coq.error "Usage: derive.param1 []". }}. Elpi Typecheck. coq-elpi-1.13.0/apps/derive/theories/derive/param1_congr.v000066400000000000000000000021471420046334000233660ustar00rootroot00000000000000(* 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 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-lib.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate File "param1_congr.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/param1_functor.v000066400000000000000000000020011420046334000237230ustar00rootroot00000000000000(* 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 Require Export elpi. Elpi Db derive.param1.functor.db lp:{{ pred param1-functor-db i:term, i:term, o:term. }}. Elpi Command derive.param1.functor. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File "param1_functor.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/derive/theories/derive/param1_inhab.v000066400000000000000000000041571420046334000233420ustar00rootroot00000000000000(* Given an inductive type I and its unary parametricity translation is_I it generates a proof IP that "forall i : I, is_U i". license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. From elpi.apps Require Export derive.param1. Definition is_uint63_witness x : is_uint63 x. Proof. constructor. Defined. Register is_uint63_witness as elpi.derive.is_uint63_witness. Definition is_float64_witness x : is_float64 x. Proof. constructor. Defined. Register is_float64_witness as elpi.derive.is_float64_witness. Elpi Db derive.param1.inhab.db lp:{{ type param1-inhab-db term -> term -> prop. param1-inhab-db {{ lib:elpi.derive.is_uint63 }} {{ lib:elpi.derive.is_uint63_witness }}. param1-inhab-db {{ lib:elpi.derive.is_float64 }} {{ lib:elpi.derive.is_float64_witness }}. 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 (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] [T,P,Q|PArgs] :- param1-inhab-db P Q, param1-inhab-db-args Args PArgs. }}. Elpi Command derive.param1.inhab. Elpi Accumulate File "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate File "param1.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.inhab.db. Elpi Accumulate File "param1_inhab.elpi" From elpi.apps.derive. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.param1.inhab.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.param1.inhab.main GR "_witness" _. main _ :- usage. usage :- coq.error "Usage: derive.param1P []". }}. Elpi Typecheck.coq-elpi-1.13.0/apps/derive/theories/derive/param1_trivial.v000066400000000000000000000047751420046334000237410ustar00rootroot00000000000000(* Given an inductive type I and its unary parametricity translation is_ it generates 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 Require Export elpi. From elpi.apps Require Export derive.param1 derive.param1_congr derive.param1_inhab. Definition is_uint63_trivial : trivial PrimInt63.int is_uint63 := fun x => contracts _ is_uint63 x (is_uint63_witness 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_witness x) (fun y => match y with float64 i => eq_refl end). Register is_float64_trivial as elpi.derive.is_float64_trivial. Elpi Db derive.param1.trivial.db lp:{{ 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 (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] [T,P,Q|PArgs] :- param1-trivial-db P Q, param1-trivial-db-args Args PArgs. }}. Elpi Command derive.param1.trivial. Elpi Accumulate File "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate File "param1.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.inhab.db. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate File "param1_trivial.elpi" From elpi.apps.derive. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.param1.trivial.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.param1.trivial.main GR "_trivial" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.trivial []". }}. Elpi Typecheck. coq-elpi-1.13.0/apps/derive/theories/derive/param2.v000066400000000000000000000030641420046334000221760ustar00rootroot00000000000000(* Binary parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi Require Export elpi. (* 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:{{ :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 "paramX-lib.elpi" From elpi.apps.derive. Elpi Accumulate File "param2.elpi" From elpi.apps.derive. Elpi Accumulate Db derive.param2.db. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I GR, derive.param2.main GR O _. main [str I] :- !, coq.locate I GR, derive.param2.main GR "_R" _. main _ :- usage. usage :- coq.error "Usage: derive.param2 []". }}. Elpi Typecheck. coq-elpi-1.13.0/apps/derive/theories/derive/projK.v000066400000000000000000000020601420046334000220740ustar00rootroot00000000000000(* 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 Require Export elpi. 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 Db derive.projK.db. Elpi Accumulate File "projK.elpi" From elpi.apps.derive. 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. coq-elpi-1.13.0/apps/eltac/000077500000000000000000000000001420046334000153345ustar00rootroot00000000000000coq-elpi-1.13.0/apps/eltac/Makefile000066400000000000000000000022111420046334000167700ustar00rootroot00000000000000# 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: @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.13.0/apps/eltac/_CoqProject000066400000000000000000000007331420046334000174720ustar00rootroot00000000000000# 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.13.0/apps/eltac/_CoqProject.test000066400000000000000000000010301420046334000204370ustar00rootroot00000000000000# 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.13.0/apps/eltac/examples/000077500000000000000000000000001420046334000171525ustar00rootroot00000000000000coq-elpi-1.13.0/apps/eltac/examples/usage_eltac.v000066400000000000000000000004701420046334000216160ustar00rootroot00000000000000From 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.13.0/apps/eltac/tests/000077500000000000000000000000001420046334000164765ustar00rootroot00000000000000coq-elpi-1.13.0/apps/eltac/tests/test_assumption.v000066400000000000000000000003041420046334000221230ustar00rootroot00000000000000From 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.13.0/apps/eltac/tests/test_case.v000066400000000000000000000012661420046334000206440ustar00rootroot00000000000000From 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.13.0/apps/eltac/tests/test_clear.v000066400000000000000000000004251420046334000210130ustar00rootroot00000000000000From elpi.apps Require Import eltac.clear. Example test_generalize_dependent x y (H : x = y) (H1 : 0 <= x) (d := x + 1) (H2 : y = 1) : x + d + y = 2. Proof. generalize dependent x. Fail eltac.clear x. eltac.clear H2. Fail match goal with Hyp : y = 1 |- _ => idtac end. Abort. coq-elpi-1.13.0/apps/eltac/tests/test_constructor.v000066400000000000000000000003741420046334000223150ustar00rootroot00000000000000From 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.13.0/apps/eltac/tests/test_cycle.v000066400000000000000000000004771420046334000210330ustar00rootroot00000000000000From 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.13.0/apps/eltac/tests/test_discriminate.v000066400000000000000000000012271420046334000224010ustar00rootroot00000000000000From elpi.apps Require Import eltac.discriminate. Set Implicit Arguments. Inductive foo (A B : Type) : nat -> Type := | K : foo A B 0 | K1 : forall n, foo A B n -> foo A B (S n) | K2 : forall n, (A -> foo A (B*B) n) -> foo A 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.13.0/apps/eltac/tests/test_fail.v000066400000000000000000000001531420046334000206360ustar00rootroot00000000000000From elpi.apps Require Import eltac.fail. Goal False. try (eltac.fail 0). Fail try (eltac.fail 1). Abort. coq-elpi-1.13.0/apps/eltac/tests/test_generalize.v000066400000000000000000000003101420046334000220430ustar00rootroot00000000000000From 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.13.0/apps/eltac/tests/test_injection.v000066400000000000000000000011111420046334000217000ustar00rootroot00000000000000From 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.13.0/apps/eltac/tests/test_intro.v000066400000000000000000000002631420046334000210600ustar00rootroot00000000000000From 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.13.0/apps/eltac/theories/000077500000000000000000000000001420046334000171565ustar00rootroot00000000000000coq-elpi-1.13.0/apps/eltac/theories/assumption.v000066400000000000000000000005021420046334000215440ustar00rootroot00000000000000From 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.13.0/apps/eltac/theories/case.v000066400000000000000000000022211420046334000202550ustar00rootroot00000000000000From 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 (T). coq-elpi-1.13.0/apps/eltac/theories/clear.v000066400000000000000000000012461420046334000204360ustar00rootroot00000000000000From 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" constr(V) := elpi clear (V). coq-elpi-1.13.0/apps/eltac/theories/constructor.v000066400000000000000000000010171420046334000217310ustar00rootroot00000000000000From 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.13.0/apps/eltac/theories/cycle.v000066400000000000000000000012471420046334000204500ustar00rootroot00000000000000From 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.13.0/apps/eltac/theories/discriminate.v000066400000000000000000000010501420046334000220140ustar00rootroot00000000000000From 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" From elpi.apps.derive. 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 (T). coq-elpi-1.13.0/apps/eltac/theories/fail.v000066400000000000000000000004571420046334000202660ustar00rootroot00000000000000From 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.13.0/apps/eltac/theories/generalize.v000066400000000000000000000011021420046334000214640ustar00rootroot00000000000000From 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 (V). coq-elpi-1.13.0/apps/eltac/theories/injection.v000066400000000000000000000011501420046334000213240ustar00rootroot00000000000000From 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" From elpi.apps.derive. 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 (T).coq-elpi-1.13.0/apps/eltac/theories/intro.v000066400000000000000000000007301420046334000205000ustar00rootroot00000000000000From 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.13.0/apps/eltac/theories/tactics.v000066400000000000000000000002161420046334000207760ustar00rootroot00000000000000From elpi.apps.eltac Require Export intro constructor assumption discriminate injection case generalize fail clear cycle .coq-elpi-1.13.0/apps/locker/000077500000000000000000000000001420046334000155235ustar00rootroot00000000000000coq-elpi-1.13.0/apps/locker/Makefile000066400000000000000000000022111420046334000171570ustar00rootroot00000000000000# 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: @$(MAKE) -f Makefile.coq $@ @$(MAKE) -f Makefile.test.coq $@ .PHONY: force all build test install: @$(MAKE) -f Makefile.coq $@ coq-elpi-1.13.0/apps/locker/Makefile.coq.local000066400000000000000000000000441420046334000210330ustar00rootroot00000000000000theories/locker.vo: elpi/locker.elpicoq-elpi-1.13.0/apps/locker/README.md000066400000000000000000000027751420046334000170150ustar00rootroot00000000000000# 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.13.0/apps/locker/_CoqProject000066400000000000000000000002611420046334000176550ustar00rootroot00000000000000# 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.13.0/apps/locker/_CoqProject.test000066400000000000000000000002751420046334000206400ustar00rootroot00000000000000# 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.13.0/apps/locker/elpi/000077500000000000000000000000001420046334000164545ustar00rootroot00000000000000coq-elpi-1.13.0/apps/locker/elpi/locker.elpi000066400000000000000000000071431420046334000206130ustar00rootroot00000000000000/* Locker */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace locker { pred key-lock i:id, i:term, i:arity. key-lock ID BoSkel AritySkel :- std.do! [ make-key ID Key, coq.arity->term AritySkel TySkel, std.assert-ok! (coq.elaborate-skeleton {{ @locked_with lp:Key lp:TySkel lp:BoSkel }} DefTy Def) "locker: illtyped definition", coq.env.add-const ID Def DefTy @transparent! C, coq.arity->implicits AritySkel CImpls, if (coq.any-implicit? CImpls) (coq.arguments.set-implicit (const C) [CImpls]) true, make-key-unlockable ID Def DefTy (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. module-lock ID BoSkel AritySkel :- std.do! [ std.assert-ok! (coq.elaborate-arity-skeleton AritySkel _ Arity) "locker: definition type illtyped", coq.arity->term Arity Ty, std.assert-ok! (coq.elaborate-skeleton BoSkel Ty Bo) "locker: definition body illtyped", lock-module-type ID Ty Bo Signature, lock-module-body Signature ID Ty Bo Symbol Module, @global! => coq.notation.add-abbreviation ID 0 Symbol ff _, coq.arity->implicits Arity CImpls, if (coq.any-implicit? CImpls) (Symbol = global GR, coq.arguments.set-implicit GR [CImpls]) true, make-module-unlockable ID Module, ]. pred lock-module-type i:id, i:term, i:term, o:modtypath. lock-module-type ID Ty Bo M :- std.do! [ Module is ID ^ "_Locked", coq.env.begin-module-type Module, coq.env.add-axiom "body" Ty C, B = global (const C), PTY = {{ lp:B = lp:Bo }}, std.assert-ok! (coq.typecheck-ty PTY _) "lock: unlock statement illtyped", coq.env.add-axiom "unlock" PTY _, coq.env.end-module-type M, ]. pred lock-module-body o:modtypath, i:id, i:term, i:term, o:term, o:modpath. lock-module-body Signature ID Ty Bo B M :- std.do! [ coq.env.begin-module ID (some Signature), coq.env.add-const "body" Bo Ty @transparent! C, B = global (const C), 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", 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 DefTy 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:DefTy 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 [_,UnlockEQ], Unlock = {{ Unlockable lp:{{ global UnlockEQ }} }}, 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.13.0/apps/locker/tests/000077500000000000000000000000001420046334000166655ustar00rootroot00000000000000coq-elpi-1.13.0/apps/locker/tests/test_locker.v000066400000000000000000000026371420046334000214020ustar00rootroot00000000000000From 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. Unset Implicit Arguments. lock Definition cons2 {A} x xs := @cons A x xs. About cons2. Definition foo := cons2 0 nil. Class EqDecision (A : Type) := { f : A -> A -> bool }. #[local] Instance xx : EqDecision nat := {| f := (fun _ _ => true) |}. lock Definition cons3 [A] `{EqDecision A} x xs := @cons A x xs. Definition foo3 := cons3 0 nil. About cons3. End Bug_286. coq-elpi-1.13.0/apps/locker/theories/000077500000000000000000000000001420046334000173455ustar00rootroot00000000000000coq-elpi-1.13.0/apps/locker/theories/locker.v000066400000000000000000000034711420046334000210200ustar00rootroot00000000000000(* Locking mechanisms. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) 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" From elpi.apps.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. 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" From elpi.apps.locker. Elpi Accumulate lp:{{ main [const-decl ID (some Bo) Ty] :- !, locker.module-lock ID Bo Ty. main _ :- coq.error "Usage: mlock Definition ...". }}. Elpi Typecheck. Elpi Export mlock. coq-elpi-1.13.0/coq-builtin.elpi000066400000000000000000001635671420046334000164240ustar00rootroot00000000000000 % 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 commands. [Definition], [Axiom], [Record] and [Context] % take precedence over the [str] argument above (when not "quoted"). % % Eg. Record m A : T := K { f : t; .. }. type indt-decl indt-decl -> argument. % Eg. Definition m A : T := B. (or Axiom when the body is none) type const-decl id -> option term -> arity -> 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 universe -> term. % Prop, Type@{i} % constants: inductive types, inductive constructors, definitions type global gref -> 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 %type proj @gref -> term -> term. % applied primitive projection % 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 _)). } % 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 :- !, if (var S) (declare_constraint (evar X T S) [X, S]) true. % If S is assigned we consider its a well type term :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 @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 @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 % 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 tt]. % Attributes for a record field. Can be left unspecified, see defaults % below. kind field-attribute type. type coercion bool -> field-attribute. % default false type canonical bool -> field-attribute. % default true, if field is named %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 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.say ...] Prints an info 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. external pred coq.env.typeof i:gref, o:term. external pred coq.env.indt % reads the inductive type declaration for the environment 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 i:inductive, % reference to the inductive type o:indt-decl. % HOAS description of the inductive type % [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) 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.const GR Bo Ty] reads the type Ty and the body Bo of constant GR. % Opaque constants have Bo = none. 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 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) 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. % [coq.env.module MP Contents] lists the contents of a module (recurses on % submodules) *E* external pred coq.env.module i:modpath, o:list gref. % [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.current-path Path] lists the current module path external pred coq.env.current-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: 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) % [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) 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) % - @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: % - @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 ] 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)). % -- Universes -------------------------------------------------------- % Univ.Universe.t typeabbrev univ (ctype "univ"). % Universes (for the sort term former) kind universe type. type prop universe. % impredicative sort of propositions type sprop universe. % impredicative sort of propositions with definitional proof irrelevance type typ univ -> universe. % predicative sort of data (carries a level) % [coq.univ.print] prints the set of universe constraints external pred coq.univ.print . % [coq.univ.leq U1 U2] constrains U1 <= U2 external pred coq.univ.leq i:univ, i:univ. % [coq.univ.eq U1 U2] constrains U1 = U2 external pred coq.univ.eq i:univ, i:univ. % [coq.univ.new Names U] fresh universe *E* external pred coq.univ.new i:list id, o:univ. % [coq.univ.sup U1 U2] constrains U2 = U1 + 1 external pred coq.univ.sup i:univ, i:univ. % [coq.univ.max U1 U2 U3] constrains U3 = max U1 U2 external pred coq.univ.max i:univ, i:univ, o:univ. % Very low level, don't use % [coq.univ.algebraic-max U1 U2 U3] constrains U3 = Max(U1,U2) *E* external pred coq.univ.algebraic-max i:univ, i:univ, o:univ. % [coq.univ.algebraic-sup U1 U2] constrains U2 = Sup(U1) *E* external pred coq.univ.algebraic-sup i:univ, o:univ. % -- 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.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. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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 universe -> 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 Db] reads all instances external pred coq.TC.db o:list tc-instance. % [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) 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 (option 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 (option 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. % -- 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:universe, 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. 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. external pred coq.elaborate-ty-skeleton i:term, o:universe, o:term, o:diagnostic. % -- Coq's reduction machines ------------------------------------ % [coq.reduction.lazy.whd_all T Tred] Puts T in weak head normal form external pred coq.reduction.lazy.whd_all i:term, o:term. % [coq.reduction.lazy.norm T Tred] Puts T in normal form external pred coq.reduction.lazy.norm i:term, o:term. % [coq.reduction.cbv.norm T Tred] Puts T in weak head normal form external pred coq.reduction.cbv.norm i:term, o:term. % [coq.reduction.vm.norm T Ty Tred] Puts T in normal form. 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. 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. % -- 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 -------------------------------------------- % [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 named Tac on goal G % (passing the arguments of G, see coq.ltac.call for a handy wrapper) external pred coq.ltac.call-ltac1 i:string, 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.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) % [coq.elpi.accumulate Scope DbName Clause] % Declare that, once the program is over, the given clause 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) external pred coq.elpi.accumulate i:scope, i:id, i:clause. % -- 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). % 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.13.0/coq-elpi.opam000066400000000000000000000027001420046334000156670ustar00rootroot00000000000000opam-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" "ocaml" {>= "4.07"} "elpi" {>= "1.14.0" & < "1.15.0~"} "coq" {>= "8.15" & < "8.16~" } ] tags: [ "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.13.0/default.nix000066400000000000000000000006611420046334000154500ustar00rootroot00000000000000{ 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.13.0/elpi-builtin.elpi000066400000000000000000001111131420046334000165470ustar00rootroot00000000000000% 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 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 constant occurs in the term i:any, % a constant (global or 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. % -- 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. coq-elpi-1.13.0/elpi/000077500000000000000000000000001420046334000142325ustar00rootroot00000000000000coq-elpi-1.13.0/elpi/README.md000066400000000000000000000015371420046334000155170ustar00rootroot00000000000000### 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.13.0/elpi/coq-HOAS.elpi000066400000000000000000000445741420046334000164350ustar00rootroot00000000000000%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 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 commands. [Definition], [Axiom], [Record] and [Context] % take precedence over the [str] argument above (when not "quoted"). % % Eg. Record m A : T := K { f : t; .. }. type indt-decl indt-decl -> argument. % Eg. Definition m A : T := B. (or Axiom when the body is none) type const-decl id -> option term -> arity -> 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 universe -> term. % Prop, Type@{i} % constants: inductive types, inductive constructors, definitions type global gref -> 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 %type proj @gref -> term -> term. % applied primitive projection % 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 _)). } % 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 :- !, if (var S) (declare_constraint (evar X T S) [X, S]) true. % If S is assigned we consider its a well type term :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 @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 @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 % 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 tt]. coq-elpi-1.13.0/elpi/coq-elaborator.elpi000066400000000000000000000011331420046334000200150ustar00rootroot00000000000000/* 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" :before "default-assign-evar" evar X Ty R :- !, of X Ty 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. coq-elpi-1.13.0/elpi/coq-elpi-checker.elpi000066400000000000000000000016131420046334000202210ustar00rootroot00000000000000/* 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.13.0/elpi/coq-lib.elpi000066400000000000000000000673171420046334000164510ustar00rootroot00000000000000/* 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 (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 (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.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), (copy (global (indt GR)) 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. % 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-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 :- coq.arity->term Arity A, do-ok! Diag [ coq.typecheck-ty A _, coq.typecheck-indt-decl.heuristic-var-type A, d\ @pi-parameter ID A i\ forall-ok (KDecl i) (coq.typecheck-indt-decl-c i A) 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 (constructor "fields" (arity (K i))) ] ]. pred coq.typecheck-indt-decl-c i:term, i:term, i:indc-decl, o:diagnostic. coq.typecheck-indt-decl-c I S (constructor _ID Arity) Diag :- coq.arity->term Arity T, do-ok! Diag [ coq.typecheck-ty T KS, coq.typecheck-indt-decl-c.unify-arrow-tgt I S T, lift-ok (coq.arity->sort S IS) "", lift-ok (if (IS = typ U1, KS = typ U2) (coq.univ.leq U2 U1) true) "constructor universe too large" ]. pred coq.typecheck-indt-decl-c.unify-arrow-tgt i:term, i:term, i:term, o:diagnostic. coq.typecheck-indt-decl-c.unify-arrow-tgt I A (prod N S T) D :- @pi-decl N S x\ coq.typecheck-indt-decl-c.unify-arrow-tgt I A (T x) D. coq.typecheck-indt-decl-c.unify-arrow-tgt I A (let N S B T) D :- @pi-def N S B x\ coq.typecheck-indt-decl-c.unify-arrow-tgt I A (T x) D. coq.typecheck-indt-decl-c.unify-arrow-tgt I A Concl D :- coq.count-prods A N, coq.mk-n-holes N 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, 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 A1) (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:universe, 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 (if (U = typ U1, UA = typ U2) (coq.univ.leq U2 U1) true) "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:term, i:indc-decl, o:indc-decl, o:diagnostic. coq.elaborate-indt-decl-skeleton-c I S (constructor ID Arity) (constructor ID Arity1) Diag :- do-ok! Diag [ coq.elaborate-arity-skeleton Arity KS Arity1, coq.typecheck-indt-decl-c.unify-arity-tgt I S Arity1, lift-ok (coq.arity->sort S IS) "", lift-ok (if (IS = typ U1, KS = typ U2) (coq.univ.leq U2 U1) true) "constructor universe too large" ]. pred coq.typecheck-indt-decl-c.unify-arity-tgt i:term, i:term, i:arity, o:diagnostic. coq.typecheck-indt-decl-c.unify-arity-tgt I A (parameter ID _ T C) D :- @pi-parameter ID T p\ coq.typecheck-indt-decl-c.unify-arity-tgt I A (C p) D. coq.typecheck-indt-decl-c.unify-arity-tgt I A (arity C) D :- coq.typecheck-indt-decl-c.unify-arrow-tgt I A C D. % Lifts coq.elaborate-skeleton to arity pred coq.elaborate-arity-skeleton i:arity, o:universe, o:arity, o:diagnostic. coq.elaborate-arity-skeleton (parameter ID Imp T A) U (parameter ID Imp T1 A1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton T _ T1, % parameters don't count d\ @pi-parameter ID T1 i\ coq.elaborate-arity-skeleton (A i) U (A1 i) d ]. coq.elaborate-arity-skeleton (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:universe. 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 (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. % 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 [] (global (indt GR)) Args, coq.env.indt GR _ Lno _ Arity Kn Kt, take Lno Args LArgs, coq.mk-app (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\ coq.mk-app (global (indc k)) LArgs) 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" type get-option string -> A -> prop. 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.13.0/elpi/elpi-command-template.elpi000066400000000000000000000006421420046334000212650ustar00rootroot00000000000000/* Loaded when Elpi Tactic 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.13.0/elpi/elpi-elaborator.elpi000066400000000000000000000351601420046334000201730ustar00rootroot00000000000000/* 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. type get-option string -> A -> prop. 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 (typ S1)) [] (sort (typ S2)) [] M eq :- !, swap M coq.univ.eq S1 S2. unif (sort (typ S1)) [] (sort (typ S2)) [] M leq :- !, swap M coq.univ.leq S1 S2. unif (sort (typ _)) [] (sort prop) [] ff _ :- !, fail. unif (sort prop) [] (sort (typ _)) [] ff eq :- !, fail. unif (sort prop) [] (sort (typ _)) [] ff leq :- !. unif (sort prop) [] (sort prop) [] ff eq :- !. unif (sort X) [] (sort X) [] ff _ :- !. 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. % 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 % 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 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 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 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 (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 prop) (sort (typ U)) (sort prop) :- if (var U) (coq.univ.new [] U) true. of (sort (typ T) as X) (sort S) X :- % XXX TODO: unif coq.univ.sup T T+1, if (var S) (S = typ T+1) (if (S = prop) false (S = typ U, coq.univ.leq T+1 U)). of (sort V) T X :- var V, coq.univ.new [] U, V = typ U, of (sort V) T X. of (global GR as X) T X :- 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. % PTS sorts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred pts i:universe, i:universe, o:universe. pts prop prop prop. pts (typ U) prop prop :- if (var U) (coq.univ.new [] U) true. pts (typ T1) (typ T2) (typ M) :- coq.univ.max T1 T2 M. pts prop (typ T2) (typ T2). pts (uvar as X) (prop as Y) R :- coq.univ.new [] U, X = typ U, pts X Y R. pts (prop as X) (uvar as Y) R :- coq.univ.new [] U, Y = typ U, pts X X R. pts (uvar as X) (typ _ as Y) R :- coq.univ.new [] U, X = typ U, pts X Y R. pts (typ _ as X) (uvar as Y) R :- coq.univ.new [] U, Y = typ U, pts X Y R. pts (uvar as X) (uvar as Y) R :- not(var R), R = prop, !, X = prop, Y = prop. pts (uvar as X) (uvar as Y) R :- var R, !, coq.univ.new [] U, X = typ U, coq.univ.new [] V, Y = typ V, pts X Y R. % vim:set ft=lprolog spelllang=: coq-elpi-1.13.0/elpi/elpi-ltac.elpi000066400000000000000000000110111420046334000167510ustar00rootroot00000000000000/* 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 _ Ev _) GS :- RawEv = T, coq.ltac.collect-goals Ev GS _. pred refine.typecheck i:term, i:goal, o:list sealed-goal. refine.typecheck T (goal _ _ Ty Ev _) GS :- coq.typecheck T Ty ok, Ev = T, coq.ltac.collect-goals Ev GS _. pred refine.no_check i:term, i:goal, o:list sealed-goal. refine.no_check T (goal _ _ _ Ev _) GS :- Ev = T, coq.ltac.collect-goals Ev GS _. % 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 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.13.0/elpi/elpi-reduction.elpi000066400000000000000000000075151420046334000200400ustar00rootroot00000000000000/* 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 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:stack, % args o:term, % body o:stack. % args after hd-beta unfold GR A BO BOC :- 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.13.0/elpi/elpi-tactic-template.elpi000066400000000000000000000011031420046334000211070ustar00rootroot00000000000000/* 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.13.0/etc/000077500000000000000000000000001420046334000140545ustar00rootroot00000000000000coq-elpi-1.13.0/etc/alectryon_elpi.py000077500000000000000000000272551420046334000174550ustar00rootroot00000000000000#!/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("Permalink",re.IGNORECASE) ghref_scrape_href_re = re.compile('href=([\'"])(.*?)\\1',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 try: with request.urlopen(uri) as f: html = f.read().decode('utf-8') except: msg = inliner.reporter.error("{}: could not download: {}".format(role,uri), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] try: link = ghref_scrape_re.search(html).group(1) puri = ghref_scrape_href_re.search(link).group(2) 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" + puri rawuri = puri.replace('/blob/','/raw/') 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.13.0/etc/coq-elpi.lang000066400000000000000000000273501420046334000164370ustar00rootroot00000000000000 *.v \(\* \*\)