├── .gitattributes ├── .github └── workflows │ ├── ci.yml │ ├── doc.yml │ ├── nix-action-coq-8.20.yml │ ├── nix-action-coq-master.yml │ ├── nix-action-rocq-9.0.yml │ └── release.yml ├── .gitignore ├── .nix ├── config.nix ├── coq-nix-toolbox.nix └── coq-overlays │ ├── coq-elpi-tests-stdlib │ └── default.nix │ └── coq-elpi-tests │ └── default.nix ├── .vscode └── settings.json ├── Changelog.md ├── LICENSE ├── Makefile ├── README.md ├── _CoqProject ├── apps ├── NES │ ├── elpi │ │ ├── dune │ │ ├── nes_interp.elpi │ │ └── nes_synterp.elpi │ ├── examples │ │ ├── dune │ │ └── usage_NES.v │ ├── tests │ │ ├── dune │ │ ├── test_NES.v │ │ ├── test_NES_lib.v │ │ ├── test_NES_perf.v │ │ ├── test_NES_perf_optimal.v │ │ ├── test_NES_resolve.v │ │ └── test_module_namespace.v │ └── theories │ │ ├── NES.v │ │ └── dune ├── README.md ├── coercion │ ├── README.md │ ├── src │ │ ├── dune.in │ │ ├── elpi_coercion_plugin.mlpack │ │ └── rocq_elpi_coercion_hook.mlg │ ├── tests │ │ ├── dune │ │ ├── test.v │ │ ├── test2.v │ │ └── test_open.v │ └── theories │ │ ├── coercion.v │ │ └── dune ├── cs │ ├── README.md │ ├── src │ │ ├── dune.in │ │ ├── elpi_cs_plugin.mlpack │ │ └── rocq_elpi_cs_hook.mlg │ ├── tests │ │ ├── cs.t.disabled_broken_8.19 │ │ │ ├── run.t.disabled_broken_8.19 │ │ │ └── test.v │ │ └── dune │ └── theories │ │ ├── cs.v │ │ └── dune ├── derive │ ├── README.md │ ├── derive.svg │ ├── elpi │ │ ├── bcongr.elpi │ │ ├── cast.elpi │ │ ├── derive.elpi │ │ ├── derive_hook.elpi │ │ ├── derive_synterp.elpi │ │ ├── derive_synterp_hook.elpi │ │ ├── discriminate.elpi │ │ ├── dune │ │ ├── eq.elpi │ │ ├── eqK.elpi │ │ ├── eqOK.elpi │ │ ├── eqType.elpi │ │ ├── eqb.elpi │ │ ├── eqbOK.elpi │ │ ├── eqbcorrect.elpi │ │ ├── eqcorrect.elpi │ │ ├── fields.elpi │ │ ├── idx2inv.elpi │ │ ├── induction.elpi │ │ ├── injection.elpi │ │ ├── invert.elpi │ │ ├── isK.elpi │ │ ├── lens.elpi │ │ ├── lens_laws.elpi │ │ ├── map.elpi │ │ ├── param1.elpi │ │ ├── param1_congr.elpi │ │ ├── param1_functor.elpi │ │ ├── param1_inhab.elpi │ │ ├── param1_trivial.elpi │ │ ├── param2.elpi │ │ ├── paramX_lib.elpi │ │ ├── projK.elpi │ │ └── tag.elpi │ ├── examples │ │ ├── dune │ │ ├── readme.v │ │ └── usage.v │ ├── tests-stdlib │ │ ├── dune │ │ └── test_derive.v │ ├── tests │ │ ├── dune │ │ ├── test_bcongr.v │ │ ├── test_derive_corelib.v │ │ ├── test_derive_vector.v.skip │ │ ├── test_eq.v │ │ ├── test_eqK.v │ │ ├── test_eqOK.v │ │ ├── test_eqType_ast.v │ │ ├── test_eqb.v │ │ ├── test_eqbOK.v │ │ ├── test_eqbcorrect.v │ │ ├── test_eqcorrect.v │ │ ├── test_fields.v │ │ ├── test_idx2inv.v │ │ ├── test_induction.v │ │ ├── test_invert.v │ │ ├── test_isK.v │ │ ├── test_lens.v │ │ ├── test_lens_laws.v │ │ ├── test_map.v │ │ ├── test_param1.v │ │ ├── test_param1_congr.v │ │ ├── test_param1_functor.v │ │ ├── test_param1_trivial.v │ │ ├── test_param2.v │ │ ├── test_projK.v │ │ ├── test_readme.v │ │ └── test_tag.v │ └── theories │ │ ├── derive.v │ │ ├── derive │ │ ├── EqdepFacts.v │ │ ├── bcongr.v │ │ ├── cast.v │ │ ├── eq.v │ │ ├── eqK.v │ │ ├── eqOK.v │ │ ├── eqOK_trivial.v.skip │ │ ├── eqType_ast.v │ │ ├── eqb.v │ │ ├── eqbOK.v │ │ ├── eqb_core_defs.v │ │ ├── eqbcorrect.v │ │ ├── eqcorrect.v │ │ ├── experimental.v │ │ ├── fields.v │ │ ├── idx2inv.v │ │ ├── induction.v │ │ ├── invert.v │ │ ├── isK.v │ │ ├── legacy.v │ │ ├── lens.v │ │ ├── lens_laws.v │ │ ├── map.v │ │ ├── param1.v │ │ ├── param1_congr.v │ │ ├── param1_functor.v │ │ ├── param1_trivial.v │ │ ├── param2.v │ │ ├── projK.v │ │ ├── std.v │ │ └── tag.v │ │ └── dune ├── eltac │ ├── examples │ │ ├── dune │ │ └── usage_eltac.v │ ├── tests-stdlib │ │ ├── dune │ │ └── test_injection.v │ ├── tests │ │ ├── dune │ │ ├── test_apply.v │ │ ├── test_assumption.v │ │ ├── test_case.v │ │ ├── test_clear.v │ │ ├── test_constructor.v │ │ ├── test_cycle.v │ │ ├── test_discriminate.v │ │ ├── test_fail.v │ │ ├── test_generalize.v │ │ ├── test_intro.v │ │ └── test_rewrite.v │ └── theories │ │ ├── apply.v │ │ ├── assumption.v │ │ ├── case.v │ │ ├── clear.v │ │ ├── constructor.v │ │ ├── cycle.v │ │ ├── discriminate.v │ │ ├── dune │ │ ├── fail.v │ │ ├── generalize.v │ │ ├── injection.v │ │ ├── intro.v │ │ ├── rewrite.v │ │ └── tactics.v ├── locker │ ├── README.md │ ├── elpi │ │ ├── dune │ │ └── locker.elpi │ ├── tests │ │ ├── dune │ │ └── test_locker.v │ └── theories │ │ ├── dune │ │ └── locker.v └── tc │ ├── README.md │ ├── elpi │ ├── WIP │ │ ├── deactivate_evar.elpi │ │ ├── force_llam.elpi │ │ └── modes.elpi │ ├── alias.elpi │ ├── base.elpi │ ├── compiler1.elpi │ ├── create_tc_predicate.elpi │ ├── dune │ ├── ho_compile.elpi │ ├── ho_link.elpi │ ├── ho_precompile.elpi │ ├── modes.elpi │ ├── parser_addInstances.elpi │ ├── rewrite_forward.elpi │ ├── solver.elpi │ ├── tc_aux.elpi │ ├── tc_same_order.elpi │ └── unif.elpi │ ├── examples │ ├── dune │ └── tutorial.v │ ├── src │ ├── dune.in │ ├── elpi_tc_plugin.mlpack │ ├── rocq_elpi_class_tactics_takeover.ml │ ├── rocq_elpi_class_tactics_takeover.mli │ ├── rocq_elpi_tc_hook.mlg │ ├── rocq_elpi_tc_register.ml │ └── rocq_elpi_tc_time.ml │ ├── tests-stdlib │ ├── bench │ │ ├── bench_inj.py │ │ └── bench_inj.v │ ├── bigTest.v │ ├── dune │ ├── eqSimplDef.v │ ├── stdppInj.v │ ├── stdppInjClassic.v │ ├── test_commands_API.v │ └── test_import │ │ ├── f1.v │ │ └── f2.v │ ├── tests │ ├── WIP │ │ ├── add_alias.v │ │ ├── cyclicTC_jarl.v │ │ ├── included_proof.v │ │ └── premisesSort │ │ │ ├── sort1.v │ │ │ ├── sort2.v │ │ │ ├── sort3.v │ │ │ ├── sort4.v │ │ │ └── sortCode.v │ ├── auto_compile.v │ ├── compile_add_pred.v.skip │ ├── contextDeepHierarchy.v │ ├── dune │ ├── hook_test.v │ ├── hyp_in_conl.v │ ├── importOrder │ │ ├── f1.v │ │ ├── f2a.v │ │ ├── f2b.v │ │ ├── f3a.v │ │ ├── f3b.v │ │ ├── f3c.v │ │ ├── f3d.v │ │ ├── f3e.v │ │ ├── f3f.v │ │ ├── f3g.v │ │ ├── f4.v │ │ └── sameOrderCommand.v │ ├── indt_to_inst.v │ ├── injTest.v │ ├── lemma_with_max_impl.v │ ├── multi_var.v │ ├── nobacktrack.v │ ├── out │ │ └── out.v │ ├── patternFragment.v │ ├── prim_proj.v │ ├── register │ │ ├── f1.v │ │ ├── f2.v │ │ └── f3.v │ ├── section_in_out.v │ ├── test.v │ ├── test_HO.v │ ├── test_backtrack_several_goals.v │ ├── test_coercion.v │ ├── test_coercion_import.v │ ├── test_eta.v │ ├── test_pending_mode.v │ ├── test_scope.v │ ├── test_shelve.v │ ├── test_tc.v │ ├── test_tc_declare.v │ ├── test_tele_app.v │ ├── test_unfold.v │ └── tlc.v │ └── theories │ ├── add_commands.v │ ├── db.v │ ├── dune │ ├── tc.v │ └── wip.v ├── builtin-doc ├── coq-builtin-synterp.elpi ├── coq-builtin.elpi ├── dune ├── elpi-builtin.elpi └── gen_doc.ml ├── coq-elpi.opam ├── default.nix ├── dune ├── dune-project ├── elpi ├── README.md ├── coq-HOAS.elpi ├── coq-arg-HOAS.elpi ├── coq-elaborator.elpi ├── coq-elpi-checker.elpi ├── coq-lib-common.elpi ├── coq-lib.elpi ├── dune ├── elpi-command-template-synterp.elpi ├── elpi-command-template.elpi ├── elpi-ltac.elpi ├── elpi-reduction.elpi ├── elpi-tactic-template.elpi └── elpi_elaborator.elpi ├── etc ├── alectryon_elpi.py ├── coq-elpi.lang ├── dune ├── logo.png ├── optcomp.ml ├── shafile.ml ├── tools │ ├── dune │ ├── hash.ml │ └── hash.mli ├── tracer.png ├── tutorial_style.rst ├── version_parser.ml └── with-rocq-wrap.sh ├── examples-stdlib ├── dune ├── example_open_terms.v └── example_reflexive_tactic.v ├── examples ├── dune ├── example_abs_evars.v ├── example_curry_howard_tactics.v ├── example_data_base.v ├── example_fuzzer.v ├── example_generalize.v ├── example_import_projections.v ├── example_record_expansion.v ├── example_record_to_sigma.v ├── example_reduction_surgery.v ├── tutorial_coq_elpi_HOAS.v ├── tutorial_coq_elpi_command.v ├── tutorial_coq_elpi_tactic.v └── tutorial_elpi_lang.v ├── rocq-elpi.opam ├── src ├── README.md ├── dune.in ├── elpi_plugin.mlpack ├── rocq_elpi_HOAS.ml ├── rocq_elpi_HOAS.mli ├── rocq_elpi_arg_HOAS.ml ├── rocq_elpi_arg_HOAS.mli ├── rocq_elpi_arg_syntax.mlg ├── rocq_elpi_builtins.ml ├── rocq_elpi_builtins.mli ├── rocq_elpi_builtins_synterp.ml ├── rocq_elpi_builtins_synterp.mli ├── rocq_elpi_glob_quotation.ml ├── rocq_elpi_glob_quotation.mli ├── rocq_elpi_graph.ml ├── rocq_elpi_graph.mli ├── rocq_elpi_name_quotation.ml ├── rocq_elpi_programs.ml ├── rocq_elpi_programs.mli ├── rocq_elpi_utils.ml ├── rocq_elpi_utils.mli ├── rocq_elpi_vernacular.ml ├── rocq_elpi_vernacular.mli └── rocq_elpi_vernacular_syntax.mlg ├── tests-stdlib ├── dune ├── test_API_env.v ├── test_API_register.v ├── test_open_terms.v └── test_quotation.v ├── tests ├── accumulate1.v ├── accumulate2.v ├── boom.elpi ├── bug_748.v ├── dune ├── library.elpi ├── perf_calls.v ├── program.v ├── test_API.v ├── test_API2.v ├── test_API_TC_CS.v ├── test_API_arguments.v ├── test_API_context.v ├── test_API_elaborate.v ├── test_API_module.v ├── test_API_new_pred.v ├── test_API_notations.v ├── test_API_section.v ├── test_API_typecheck.v ├── test_COQ_ELPI_ATTRIBUTES.v.disabled ├── test_File1.v ├── test_File2.v ├── test_File3.v ├── test_File4.v ├── test_HOAS.v ├── test_accumulate_twice.v ├── test_arg_HOAS.v ├── test_cache_async.v ├── test_ctx_cache.v ├── test_elaborator.v ├── test_glob.v ├── test_lib.v ├── test_libobject_A.v ├── test_libobject_B.v ├── test_libobject_C.v ├── test_link_order1.v ├── test_link_order2.v ├── test_link_order3.v ├── test_link_order4.v ├── test_link_order5.v ├── test_link_order6.v ├── test_link_order7.v ├── test_link_order8.v ├── test_link_order9.v ├── test_link_order_import0.v ├── test_link_order_import1.v ├── test_link_order_import2.v ├── test_link_order_import3.ref ├── test_link_order_import3.v ├── test_link_perf.v ├── test_ltac.v ├── test_ltac2.v ├── test_ltac3.v ├── test_ltac4.v ├── test_query_extra_dep.v ├── test_require_bad_order.v ├── test_synterp.v ├── test_tactic.v ├── test_toposort.v ├── test_vernacular1.v └── test_vernacular2.v ├── theories-stdlib ├── Arith.v.in ├── Bool.v.in ├── Eqdep_dec.v.in ├── FunctionalExtensionality.v.in ├── List.v.in ├── Peano.v.in ├── Permutation.v.in ├── Program │ ├── Basics.v.in │ ├── Syntax.v.in │ └── dune ├── Ranalysis5.v.in ├── Utf8.v.in ├── Vector.v.in ├── ZArith.v.in └── dune.in └── theories ├── attic ├── dune ├── test_CoqEAL.v ├── test_eq.v └── test_gen.v ├── core ├── Bool.v.in ├── ListDef.v.in ├── Morphisms.v.in ├── PosDef.v.in ├── PrimFloat.v.in ├── PrimInt63.v.in ├── PrimString.v.in ├── PrimStringAxioms.v.in ├── RelationClasses.v.in ├── Setoid.v.in ├── Uint63Axioms.v.in ├── dune ├── ssrbool.v.in ├── ssreflect.v.in └── ssrfun.v.in ├── dune ├── elpi.v.in └── wip ├── dune └── memoization.v /.gitattributes: -------------------------------------------------------------------------------- 1 | *.elpi linguist-language=prolog 2 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: CI 4 | 5 | # Controls when the action will run. Triggers the workflow on push or pull request 6 | # events but only for the master branch 7 | on: 8 | push: 9 | branches: [ master ] 10 | tags: [ "v*.*.*" ] 11 | pull_request: 12 | branches: [ master ] 13 | jobs: 14 | 15 | docker: 16 | runs-on: ubuntu-latest # container actions require GNU/Linux 17 | strategy: 18 | matrix: 19 | image: 20 | - 'rocq/rocq-prover:dev' 21 | - 'rocq/rocq-prover:9.0' 22 | - 'coqorg/coq:8.20' 23 | profile: 24 | - dev 25 | include: 26 | - image: 'coqorg/coq:8.20' 27 | profile: fatalwarnings 28 | fail-fast: false # don't stop jobs if one fails 29 | steps: 30 | - uses: actions/checkout@v3 31 | - uses: coq-community/docker-coq-action@v1 32 | with: 33 | opam_file: 'rocq-elpi.opam' 34 | custom_image: ${{ matrix.image }} 35 | before_script: | 36 | sudo chmod -R a+w . 37 | if [ "${{ matrix.profile }}" = "fatalwarnings" ]; then sed -i 's/-A/+A/' dune; fi 38 | after_script: | 39 | make all-examples 40 | make all-tests 41 | export: 'OPAMWITHTEST OPAMIGNORECONSTRAINTS OPAMVERBOSE' # space-separated list of variables 42 | env: 43 | OPAMWITHTEST: 'true' 44 | OPAMIGNORECONSTRAINTS: 'coq' 45 | OPAMVERBOSE: '3' 46 | -------------------------------------------------------------------------------- /.github/workflows/doc.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: DOC 4 | 5 | # Controls when the action will run. Triggers the workflow on push or pull request 6 | # events but only for the master branch 7 | on: 8 | push: 9 | branches: [ master ] 10 | pull_request: 11 | branches: [ master ] 12 | 13 | jobs: 14 | build: 15 | name: Build doc 16 | runs-on: ubuntu-latest 17 | steps: 18 | 19 | - name: workaround bug 20 | run: sudo apt-get update 21 | 22 | - name: checkout 23 | uses: actions/checkout@v3 24 | 25 | - name: setup ocaml 26 | uses: ocaml/setup-ocaml@v3 27 | with: 28 | ocaml-compiler: 4.14.2 29 | 30 | - name: install deps 31 | run: | 32 | export OPAMYES=true 33 | opam repo add coq https://coq.inria.fr/opam/released 34 | opam repo add coq-dev https://coq.inria.fr/opam/core-dev 35 | opam repo add extra-dev https://coq.inria.fr/opam/extra-dev 36 | opam update 37 | opam install coq-serapi.8.20.0+0.20.0 ./rocq-elpi.opam coq-core.8.20.0 38 | sudo apt-get update 39 | sudo apt-get install python3-pip -y 40 | pip3 install git+https://github.com/cpitclaudel/alectryon.git@c8ab1ec 41 | 42 | - name: build doc 43 | run: | 44 | opam exec -- make dune-files 45 | opam exec -- make doc COQ_ELPI_ALREADY_INSTALLED=1 46 | 47 | - name: Save artifact 48 | uses: actions/upload-artifact@v4 49 | with: 50 | path: doc 51 | 52 | - name: deploy 53 | uses: JamesIves/github-pages-deploy-action@4.1.4 54 | if: ${{ github.ref == 'refs/heads/master' }} 55 | with: 56 | branch: gh-pages 57 | folder: doc 58 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.cmx 3 | *.cmo 4 | *.cmi 5 | *.a 6 | *.cmxa 7 | *.cmxs 8 | *.cma 9 | *.cmt 10 | *.cmti 11 | *.annot 12 | 13 | .*~ 14 | .*.swp 15 | 16 | *.vo 17 | *.vos 18 | *.vok 19 | *.d 20 | *.glob 21 | .*.aux 22 | *.html 23 | *.txt 24 | *.crashcoqide 25 | \#*\# 26 | etc/__pycache__/ 27 | 28 | /.deps.elpi 29 | 30 | src/rocq_elpi_config.ml 31 | src/rocq_elpi_vernacular_syntax.ml 32 | src/rocq_elpi_arg_syntax.ml 33 | src/rocq_elpi_builtins_HOAS.ml 34 | doc/ 35 | 36 | Makefile.coq 37 | Makefile.coq.conf 38 | .merlin 39 | Makefile.*.coq 40 | Makefile.*.coq.conf 41 | 42 | tests/test_glob/*.css 43 | 44 | META 45 | 46 | *.cache 47 | 48 | apps/coercion/src/rocq_elpi_coercion_hook.ml 49 | .filestoinstall 50 | apps/tc/src/rocq_elpi_tc_hook.ml 51 | apps/cs/src/rocq_elpi_cs_hook.ml 52 | 53 | *.timing 54 | _build 55 | tmp.out 56 | rocq-elpi-tests.opam 57 | rocq-elpi-tests.install 58 | rocq-elpi.install 59 | coq-elpi.install 60 | 61 | theories-stdlib/dune 62 | -------------------------------------------------------------------------------- /.nix/coq-nix-toolbox.nix: -------------------------------------------------------------------------------- 1 | "0d640bae117cd64fd202e1453613d614b6e29aea" 2 | -------------------------------------------------------------------------------- /.nix/coq-overlays/coq-elpi-tests-stdlib/default.nix: -------------------------------------------------------------------------------- 1 | { coq-elpi, coqPackages }: 2 | 3 | coqPackages.lib.overrideCoqDerivation { 4 | 5 | pname = "coq-elpi-tests-stdlib"; 6 | 7 | propagatedBuildInputs = coq-elpi.propagatedBuildInputs 8 | ++ [ coqPackages.stdlib ]; 9 | 10 | buildPhase = '' 11 | make test-stdlib 12 | make examples-stdlib 13 | make test-apps-stdlib 14 | ''; 15 | installPhase = '' 16 | echo "nothing to install" 17 | ''; 18 | } coq-elpi 19 | -------------------------------------------------------------------------------- /.nix/coq-overlays/coq-elpi-tests/default.nix: -------------------------------------------------------------------------------- 1 | { lib, coq-elpi, coqPackages }: 2 | 3 | coqPackages.lib.overrideCoqDerivation { 4 | 5 | pname = "coq-elpi-tests"; 6 | 7 | buildPhase = '' 8 | make test-core 9 | make examples 10 | make test-apps 11 | ''; 12 | installPhase = '' 13 | echo "nothing to install" 14 | ''; 15 | } coq-elpi 16 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "files.exclude": { 3 | "**/*.o": true, 4 | "**/*.cmx": true, 5 | "**/*.cmo": true, 6 | "**/*.cmi": true, 7 | "**/*.a": true, 8 | "**/*.cmxa": true, 9 | "**/*.cmxs": true, 10 | "**/*.cma": true, 11 | "**/*.cmt": true, 12 | "**/*.cmti": true, 13 | "**/*.annot": true, 14 | "**/.*~": true, 15 | "**/.*.swp": true, 16 | "**/*.vo": true, 17 | "**/*.vos": true, 18 | "**/*.vok": true, 19 | "**/*.d": true, 20 | "**/*.glob": true, 21 | "**/.*.aux": true, 22 | "**/*.html": true, 23 | "**/*.crashcoqide": true, 24 | "**/\\#*\\#": true, 25 | ".deps.elpi": true, 26 | "src/rocq_elpi_config.ml": true, 27 | "src/rocq_elpi_vernacular_syntax.ml": true, 28 | "**/Makefile.coq": true, 29 | "**/Makefile.coq.conf": true, 30 | "**/.merlin": true 31 | }, 32 | "restructuredtext.confPath": "${workspaceFolder}/alectryon/recipes/sphinx", 33 | "ocaml.server.args": [ 34 | "--fallback-read-dot-merlin" 35 | ], 36 | } 37 | -------------------------------------------------------------------------------- /apps/NES/elpi/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.NES.elpi) 3 | (package rocq-elpi) 4 | (theories elpi)) 5 | 6 | (rule 7 | (target dummy.v) 8 | (deps 9 | (glob_files *.elpi)) 10 | (action 11 | (with-stdout-to %{target} 12 | (progn 13 | (run rocq_elpi_shafile %{deps}))))) 14 | 15 | (install 16 | (files 17 | (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/NES/elpi/))) 18 | (section lib_root) 19 | (package rocq-elpi)) 20 | -------------------------------------------------------------------------------- /apps/NES/examples/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.NES.examples) 3 | (theories elpi elpi.apps.NES)) 4 | 5 | (include_subdirs qualified) 6 | -------------------------------------------------------------------------------- /apps/NES/examples/usage_NES.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import NES. 2 | 3 | (* Namespaces are like modules, since they let you organize your notions 4 | and avoid name collisions. 5 | Namespaces are unlinke modules, since you can always add a notion to 6 | a namespace, even if the namespace was ended before. *) 7 | 8 | NES.Begin This.Is.A.Long.Namespace. 9 | Definition stuff := 1. 10 | NES.End This.Is.A.Long.Namespace. 11 | 12 | NES.Begin This.Is.A.Long.Namespace. 13 | Definition more_stuff := stuff. (* stuff in the namespace is visible *) 14 | NES.End This.Is.A.Long.Namespace. 15 | 16 | Print This.Is.A.Long.Namespace.stuff. (* = 1 *) 17 | Eval compute in This.Is.A.Long.Namespace.more_stuff. (* = 1 *) 18 | 19 | (* Unlike a module, a namespace can contain two notions with the same name. 20 | The latter shadows the former. *) 21 | 22 | NES.Begin This.Is.A.Long.Namespace. 23 | Definition stuff := 2. 24 | NES.End This.Is.A.Long.Namespace. 25 | 26 | (* Binding is static, eg more_stuff still values 1 *) 27 | Print This.Is.A.Long.Namespace.stuff. (* = 2 *) 28 | Eval compute in This.Is.A.Long.Namespace.more_stuff. (* = 1 *) 29 | 30 | (* Listing and printing namespaces *) 31 | NES.List This. 32 | (* 33 | This_aux_1.This.Is.A.Long.Namespace.stuff (* <-- shadowed *) 34 | This.Is.A.Long.Namespace.more_stuff 35 | This.Is.A.Long.Namespace.stuff 36 | *) 37 | NES.Print This. 38 | (* 39 | This_aux_1.This.Is.A.Long.Namespace.stuff : nat 40 | This.Is.A.Long.Namespace.more_stuff : nat 41 | This.Is.A.Long.Namespace.stuff : nat 42 | *) 43 | 44 | (* For convenience one can open a namespace to write short names *) 45 | NES.Open This.Is.A.Long.Namespace. 46 | Print stuff. 47 | 48 | (* Not quite a name space yet *) 49 | Structure Default := { sort : Type; default : sort }. 50 | NES.Begin CS. 51 | Global Canonical Structure nat_def := {| sort := nat; default := 46 |}. 52 | Check @default _ : nat. 53 | NES.End CS. 54 | Fail Check nat_def. 55 | (* we want nat_def to live in the CS namespace, BUT 56 | we want the canonical structure declaration to live outside the namespace *) 57 | Fail Check @default _ : nat. 58 | (* This behavior requires Libobject to be aware of the role played by 59 | a module: if it is a namespace some "actions" have to be propagated upward *) 60 | -------------------------------------------------------------------------------- /apps/NES/tests/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.NES.tests) 3 | (package rocq-elpi-tests) 4 | (theories elpi elpi.apps.NES)) 5 | 6 | (include_subdirs qualified) 7 | 8 | -------------------------------------------------------------------------------- /apps/NES/tests/test_NES.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import NES. 2 | 3 | (* Some invalid namespaces *) 4 | Fail NES.Begin. 5 | Fail NES.Begin "". 6 | Fail NES.Begin ".". 7 | Fail NES.Begin ".A". 8 | Fail NES.Begin "A.". 9 | Fail NES.Begin "A..B". 10 | Fail NES.Begin "A._.B". 11 | 12 | (* name space creation *) 13 | NES.Begin Foo. 14 | Definition x := 3. 15 | NES.End Foo. 16 | Print Foo.x. 17 | 18 | (* adding one name inside an existing name space *) 19 | NES.Begin Foo. 20 | Definition x2 := 4. 21 | NES.End Foo. 22 | Print Foo.x. 23 | Print Foo.x2. 24 | 25 | (* shadowing: adding the same name twice *) 26 | NES.Begin Foo. 27 | Definition x := 5. 28 | NES.End Foo. 29 | Check (refl_equal _ : Foo.x = 5). (* shadowing *) 30 | 31 | (* nesting *) 32 | NES.Begin A. 33 | NES.Begin B. 34 | Definition c := 1. 35 | NES.End B. 36 | NES.End A. 37 | About A.B.c. 38 | 39 | (* adding one name inside an existing, nested, name space *) 40 | NES.Begin A1. 41 | NES.Begin B1. 42 | Definition c := 1. 43 | NES.End B1. 44 | NES.Begin B1. 45 | Definition d := 1. 46 | NES.End B1. 47 | NES.End A1. 48 | About A1.B1.d. 49 | About A1.B1.c. 50 | 51 | (* all names in the Foo namespace must be visible *) 52 | NES.Open Foo. 53 | Print x. 54 | Print x2. 55 | 56 | NES.Open A1. 57 | Print B1.c. 58 | Print B1.d. 59 | 60 | NES.Open A1.B1. 61 | Print d. 62 | 63 | (* boh *) 64 | NES.Begin A2.B2. 65 | Definition e := 1. 66 | NES.End B2. 67 | NES.End A2. 68 | NES.Begin A2.B2. 69 | Definition f := 2. 70 | NES.End A2.B2. 71 | Print A2.B2.f. 72 | 73 | NES.Begin X. 74 | Module Y. 75 | Fail NES.Begin Z. 76 | End Y. 77 | NES.End X. 78 | -------------------------------------------------------------------------------- /apps/NES/tests/test_NES_lib.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.NES.elpi Extra Dependency "nes_synterp.elpi" as nes_synterp. 2 | From elpi.apps.NES.elpi Extra Dependency "nes_interp.elpi" as nes_interp. 3 | From elpi.apps Require Import NES. 4 | 5 | Elpi Command Make. 6 | #[phase="both"] Elpi Accumulate Db NES.db. 7 | #[synterp] Elpi Accumulate File nes_synterp. 8 | #[interp] Elpi Accumulate File nes_interp. 9 | #[synterp] Elpi Accumulate lp:{{ 10 | 11 | main [str Path] :- std.do! [ 12 | nes.string->ns Path NS, 13 | nes.begin-path NS OpenNS, 14 | OpenNS => nes.end-path NS _NewNS, 15 | ]. 16 | main _ :- coq.error "usage: Make ". 17 | 18 | }}. 19 | #[interp] Elpi Accumulate lp:{{ 20 | main _ :- std.do! [ 21 | nes.begin-path, 22 | coq.env.add-const "x" {{ 42 }} _ @transparent! _C, 23 | nes.end-path, 24 | ]. 25 | }}. 26 | 27 | Elpi Export Make. 28 | 29 | Make Cats.And.Dogs. 30 | Print Cats.And.Dogs.x. 31 | -------------------------------------------------------------------------------- /apps/NES/tests/test_NES_resolve.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import NES. 2 | 3 | NES.Begin A. 4 | Definition cats := 3. 5 | NES.End A. 6 | 7 | NES.Begin B. 8 | Definition dogs := 4. 9 | NES.End B. 10 | 11 | NES.Begin C. 12 | 13 | NES.Begin A. 14 | Definition bunnies := 42. 15 | NES.End A. 16 | 17 | Section more_bunnies. 18 | NES.Open A. 19 | Definition more_bunnies := bunnies. 20 | End more_bunnies. 21 | 22 | Section more_cats. 23 | NES.Open _.A. 24 | Definition more_cats := cats. 25 | End more_cats. 26 | 27 | Section more_dogs. 28 | NES.Open B. 29 | Definition more_dogs := dogs. 30 | End more_dogs. 31 | 32 | Section even_more_dogs. 33 | NES.Open _.B. 34 | Definition even_more_dogs := dogs. 35 | End even_more_dogs. 36 | 37 | NES.End C. 38 | -------------------------------------------------------------------------------- /apps/NES/tests/test_module_namespace.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import NES. 2 | 3 | Module MyModule. End MyModule. 4 | Succeed NES.Begin MyModule. 5 | -------------------------------------------------------------------------------- /apps/NES/theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.NES) 3 | (package rocq-elpi) 4 | (theories elpi elpi.apps.NES.elpi)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/README.md: -------------------------------------------------------------------------------- 1 | ## Applications written in Coq-Elpi 2 | 3 | ### Derive 4 | 5 | Given an inductive type declaration it synthesizes a bunch of useful stuff 6 | such as proved equality tests, projections, parametricity relations. 7 | 8 | ### Eltac 9 | 10 | A toy set of tactics implemented in Elpi. 11 | 12 | ### NES 13 | 14 | A Namespace Emulation System. 15 | 16 | ### Locker 17 | 18 | A kit to lock definitions hard. 19 | -------------------------------------------------------------------------------- /apps/coercion/src/dune.in: -------------------------------------------------------------------------------- 1 | (library 2 | (name elpi_coercion_plugin) 3 | (public_name rocq-elpi.coercion) 4 | (flags :standard -w -27) 5 | (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) 6 | (libraries @@ROCQ_RUNTIME@@.plugins.ltac @@ROCQ_RUNTIME@@.vernac rocq-elpi.elpi)) 7 | 8 | (coq.pp 9 | (modules rocq_elpi_coercion_hook)) 10 | -------------------------------------------------------------------------------- /apps/coercion/src/elpi_coercion_plugin.mlpack: -------------------------------------------------------------------------------- 1 | Rocq_elpi_coercion_hook 2 | -------------------------------------------------------------------------------- /apps/coercion/tests/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.coercion.tests) 3 | (package rocq-elpi-tests) 4 | (theories elpi elpi.apps.coercion)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/coercion/tests/test.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import coercion. 2 | #[warning="-deprecated-from-Coq"] 3 | 4 | Elpi Accumulate coercion.db lp:{{ 5 | 6 | coercion _ {{ True }} {{ Prop }} {{ bool }} {{ true }}. 7 | coercion _ {{ False }} {{ Prop }} {{ bool }} {{ false }}. 8 | 9 | }}. 10 | 11 | Check andb True False. 12 | 13 | Parameter ringType : Type. 14 | Parameter ringType_sort : ringType -> Type. 15 | Parameter natmul : forall (R : ringType) (n : nat), (ringType_sort R). 16 | 17 | Elpi Accumulate coercion.db lp:{{ 18 | 19 | coercion _ N {{ nat }} {{ ringType_sort lp:R }} {{ natmul lp:R lp:N }} :- 20 | coq.typecheck R {{ ringType }} ok. 21 | 22 | }}. 23 | 24 | Section TestNatMul. 25 | 26 | Variable R : ringType. 27 | Variable n : nat. 28 | 29 | Check natmul R n : ringType_sort R. 30 | Check n : ringType_sort R. 31 | 32 | End TestNatMul. 33 | -------------------------------------------------------------------------------- /apps/coercion/tests/test2.v: -------------------------------------------------------------------------------- 1 | Require Import test. 2 | 3 | Check True : bool. 4 | -------------------------------------------------------------------------------- /apps/coercion/tests/test_open.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import coercion. 2 | From elpi.core Require Import ssreflect. 3 | 4 | Ltac my_solver := try ((repeat apply: le_n_S); apply: le_0_n). 5 | 6 | Elpi Accumulate coercion lp:{{ 7 | 8 | coercion _ X Ty {{ @sig lp:Ty lp:P }} Solution :- std.do! [ 9 | % we unfold letins since the solve is dumb 10 | (pi a b b1\ copy a b :- def a _ _ b, copy b b1) => copy X X1, 11 | % we build the solution 12 | Solution = {{ @exist lp:Ty lp:P lp:X1 _ }}, 13 | % we call the solver 14 | coq.ltac.collect-goals Solution [G] [], 15 | coq.ltac.open (coq.ltac.call-ltac1 "my_solver") G [], 16 | ]. 17 | 18 | }}. 19 | 20 | Goal {x : nat | x > 0}. 21 | apply: 3. 22 | Qed. 23 | 24 | Definition add1 n : {x : nat | x > 0} := 25 | match n with 26 | | O => 1 27 | | S x as y => y 28 | end. 29 | 30 | Check 1. 31 | -------------------------------------------------------------------------------- /apps/coercion/theories/coercion.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "rocq-elpi.coercion". 2 | From elpi Require Import elpi. 3 | 4 | Elpi Db coercion.db lp:{{ 5 | 6 | % predicate [coercion Ctx V Inferred Expected Res] used to add new coercion, with 7 | % - [Ctx] is the context 8 | % - [V] is the value to be coerced 9 | % - [Inferred] is the type of [V] 10 | % - [Expected] is the type [V] should be coerced to 11 | % - [Res] is the result (of type [Expected]) 12 | % Be careful not to trigger coercion as this may loop. 13 | pred coercion i:goal-ctx, i:term, i:term, i:term, o:term. 14 | 15 | }}. 16 | 17 | Elpi Tactic coercion. 18 | Elpi Accumulate Db Header coercion.db. 19 | Elpi Accumulate lp:{{ 20 | 21 | solve (goal Ctx _ Ty Sol [trm V, trm VTy]) _ :- coercion Ctx V VTy Ty Sol. 22 | 23 | }}. 24 | Elpi Accumulate Db coercion.db. 25 | 26 | Elpi CoercionFallbackTactic coercion. 27 | -------------------------------------------------------------------------------- /apps/coercion/theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.coercion) 3 | (package rocq-elpi) 4 | (theories elpi) 5 | (plugins rocq-elpi.coercion)) 6 | 7 | (include_subdirs qualified) 8 | -------------------------------------------------------------------------------- /apps/cs/README.md: -------------------------------------------------------------------------------- 1 | # Canonical solution 2 | 3 | The `canonical_solution` app enables to program Coq canonical structure solutions in Elpi. 4 | 5 | This app is experimental. 6 | 7 | ## The cs predicate 8 | 9 | The `cs` predicate lives in the database `cs.db` 10 | 11 | ```elpi 12 | % predicate [cs Ctx Lhs Rhs] used to unify Lhs with Rhs, with 13 | % - [Ctx] is the context 14 | % - [Lhs] and [Rhs] are the terms to unify 15 | :index (0 6 6) 16 | pred cs i:goal-ctx, o:term, o:term. 17 | ``` 18 | 19 | By addings rules for this predicate one can recover from a CS instance search failure 20 | error, that is when `Lhs` and `Rhs` are not unifiable using a canonical structure registered 21 | by Coq. 22 | 23 | ## Simple example of canonical solution 24 | 25 | This example declares a structure `S` with a projection `sort` and declares 26 | a canonical solution for `nat` in `S`. 27 | 28 | ```coq 29 | From elpi.apps Require Import cs. 30 | From Coq Require Import Bool. 31 | 32 | Structure S : Type := 33 | { sort :> Type }. 34 | 35 | Elpi Accumulate cs.db lp:{{ 36 | 37 | cs _ {{ sort lp:Sol }} {{ nat }} :- 38 | Sol = {{ Build_S nat }}. 39 | 40 | }}. 41 | 42 | Check eq_refl _ : (sort _) = nat. 43 | ``` 44 | -------------------------------------------------------------------------------- /apps/cs/src/dune.in: -------------------------------------------------------------------------------- 1 | (library 2 | (name elpi_cs_plugin) 3 | (public_name rocq-elpi.cs) 4 | (flags :standard -w -27) 5 | (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) 6 | (libraries @@ROCQ_RUNTIME@@.plugins.ltac @@ROCQ_RUNTIME@@.vernac rocq-elpi.elpi)) 7 | 8 | (coq.pp 9 | (modules rocq_elpi_cs_hook)) 10 | -------------------------------------------------------------------------------- /apps/cs/src/elpi_cs_plugin.mlpack: -------------------------------------------------------------------------------- 1 | Rocq_elpi_cs_hook 2 | -------------------------------------------------------------------------------- /apps/cs/tests/cs.t.disabled_broken_8.19/run.t.disabled_broken_8.19: -------------------------------------------------------------------------------- 1 | $ DEPS="elpi elpi.apps.cs" 2 | $ . ../setup-project.sh 3 | $ dune build test.vo 4 | 1 5 | : nat 6 | eq_refl : {| sort := id (A:=nat) |} = id (A:=nat) 7 | : {| sort := id (A:=nat) |} = id (A:=nat) 8 | 11 9 | : nat 10 | eq_refl : {| sort := id (A:=nat) |} 1 = id 1 11 | : {| sort := id (A:=nat) |} 1 = id 1 12 | 2 13 | : nat 14 | eq_refl : {| sort := id (A:=nat) |} = id1 nat 15 | : {| sort := id (A:=nat) |} = id1 nat 16 | 3 17 | : nat 18 | eq_refl : sort1 nat {| sort := id (A:=nat) |} = id (A:=nat) 19 | : sort1 nat {| sort := id (A:=nat) |} = id (A:=nat) 20 | 4 21 | : nat 22 | eq_refl : sort1 nat {| sort := id (A:=nat) |} = id1 nat 23 | : sort1 nat {| sort := id (A:=nat) |} = id1 nat 24 | -------------------------------------------------------------------------------- /apps/cs/tests/cs.t.disabled_broken_8.19/test.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import cs. 2 | From Coq Require Import Bool. 3 | 4 | Structure S (T : Type) : Type := 5 | { sort :> T -> T }. 6 | 7 | Elpi Accumulate canonical_solution lp:{{ 8 | 9 | cs _ {{ sort lp:T }} {{ @id lp:T }} {{ Build_S lp:T (@id lp:T) }}. 10 | 11 | }}. 12 | 13 | Check 1. 14 | Check eq_refl _ : (sort nat _) = @id nat. 15 | Check 11. 16 | Check eq_refl _ : (sort nat _) 1 = @id nat 1. 17 | Definition id1 := id. 18 | Check 2. 19 | Check eq_refl _ : (sort nat _) = @id1 nat. 20 | Definition sort1 := sort. 21 | Check 3. 22 | Check eq_refl _ : (sort1 nat _) = @id nat. 23 | Check 4. 24 | Check eq_refl _ : (sort1 nat _) = @id1 nat. 25 | 26 | 27 | -------------------------------------------------------------------------------- /apps/cs/tests/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (applies_to :whole_subtree) 3 | (deps 4 | %{bin:coqc} 5 | %{bin:coqdep} 6 | (package rocq-elpi) 7 | setup-project.sh)) 8 | -------------------------------------------------------------------------------- /apps/cs/theories/cs.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "rocq-elpi.cs". 2 | From elpi Require Import elpi. 3 | 4 | Elpi Db cs.db lp:{{ 5 | 6 | % predicate [cs Ctx Proj Rhs Sol] used to find Sol such that Proj Sol = Rhs, where 7 | % - [Ctx] is the context 8 | % - [Proj] is the projector of some structure, applied to the structure's parameters if any 9 | % - [Rhs] the term to find a structure on. 10 | :index (0 6 6) 11 | pred cs i:goal-ctx, i:term, i:term, o:term. 12 | 13 | }}. 14 | 15 | 16 | 17 | Elpi Tactic canonical_solution. 18 | Elpi Accumulate Db cs.db. 19 | Elpi Accumulate canonical_solution lp:{{ 20 | 21 | solve (goal Ctx _ _Ty Sol [trm Proj, trm Rhs]) _ :- 22 | cs Ctx Proj Rhs Sol, 23 | % std.assert! (P = {{ eq_refl lp:Lhs }}) "cs: wrong solution". 24 | true. 25 | 26 | }}. 27 | Elpi CS canonical_solution. 28 | -------------------------------------------------------------------------------- /apps/cs/theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.cs) 3 | (package rocq-elpi) 4 | (theories elpi) 5 | (plugins rocq-elpi.cs)) 6 | 7 | (include_subdirs qualified) 8 | -------------------------------------------------------------------------------- /apps/derive/elpi/derive_hook.elpi: -------------------------------------------------------------------------------- 1 | /* Entry point for derive extensions */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | pred derivation i:gref, i:string, o:bool, o:derive. 6 | pred export i:modpath. 7 | pred dep1 o:string, o:string. 8 | kind derive type. 9 | type derive string -> (list prop -> prop) -> prop -> derive. 10 | % if a derivation fails it should end by calling stop, instead of coq.error, 11 | % so that derive can make the failure non fatal 12 | type stop string -> prop. 13 | -------------------------------------------------------------------------------- /apps/derive/elpi/derive_synterp_hook.elpi: -------------------------------------------------------------------------------- 1 | /* Entry point for derive extensions */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | pred derivation i:string, i:string, o:derive. 6 | pred export i:modpath. 7 | pred dep1 o:string, o:string. 8 | kind derive type. 9 | type derive string -> (list prop -> prop) -> prop -> derive. 10 | -------------------------------------------------------------------------------- /apps/derive/elpi/discriminate.elpi: -------------------------------------------------------------------------------- 1 | /* core of discriminate */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | shorten std.{ do! }. 6 | 7 | namespace ltac { 8 | 9 | % Tests if the command can be applied 10 | pred discriminate? i:term, i:inductive, o:list term, o:constructor, o:term, o:term. 11 | discriminate? Ty GR Args GRA A B :- do! [ 12 | whd Ty [] {{lib:@elpi.eq}} [T,A,B], 13 | whd T [] (global (indt GR)) Args, 14 | whd A [] (global (indc GRA)) _, 15 | whd B [] (global (indc GRB)) _, 16 | not(GRA = GRB) 17 | ]. 18 | 19 | % Does the job 20 | pred discriminate! i:term, i:term, o:term, i:inductive, i:list term, i:constructor, i:term, i:term. 21 | discriminate! H G PG GR Args GRA A B :- do! [ 22 | isK-db GRA IsKA, 23 | coq.mk-app IsKA Args IsKAArgs, 24 | Eq_isKA_isKB = app[{{lib:elpi.derive.eq_f}},app[global (indt GR)|Args],{{lib:elpi.bool}},IsKAArgs,A,B,H], 25 | PG = app[{{lib:elpi.bool_discr}},Eq_isKA_isKB,G] 26 | ]. 27 | 28 | pred discriminate i:term, i:term, i:term, o:term. 29 | discriminate H EqAB G PG :- 30 | if (discriminate? EqAB GR Args GRA A B) 31 | (discriminate! H G PG GR Args GRA A B) 32 | (coq.error "discriminate: the equation" {coq.term->string H} "of type" {coq.term->string EqAB} "is trivial at the top level"). 33 | 34 | } 35 | 36 | % vim:set ft=lprolog spelllang=: 37 | -------------------------------------------------------------------------------- /apps/derive/elpi/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.derive.elpi) 3 | (package rocq-elpi) 4 | (theories elpi)) 5 | 6 | (rule 7 | (target dummy.v) 8 | (deps 9 | (glob_files *.elpi)) 10 | (action 11 | (with-stdout-to %{target} 12 | (progn 13 | (run rocq_elpi_shafile %{deps}))))) 14 | 15 | (install 16 | (files 17 | (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/derive/elpi/))) 18 | (section lib_root) 19 | (package rocq-elpi)) 20 | -------------------------------------------------------------------------------- /apps/derive/elpi/eqOK.elpi: -------------------------------------------------------------------------------- 1 | /* constant elimination */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | shorten std.{assert!, do!}. 6 | 7 | namespace derive.eqOK { 8 | 9 | pred body i:int, i:term, i:term, i:term, o:term. 10 | 11 | body N (prod NA A a\ prod NF (A_eq a) (B a)) E TisT 12 | (fun NA A a\ fun NF (A_eq a) f\ 13 | fun `p` (PA a f) (B1 a f)) :- 14 | N > 0, !, M is N - 1, 15 | @pi-decl NA A a\ 16 | @pi-decl NF (A_eq a) f\ 17 | (PA a f = {{ lib:elpi.derive.eq_axiom lp:a lp:f }}, 18 | @pi-decl `p` (PA a f) p\ 19 | body M (B a f) 20 | {coq.mk-app E [a,f]} 21 | {coq.mk-app TisT [a, {{lib:elpi.derive.eq_axiom_at lp:a lp:f}}, p]} 22 | (B1 a f p)). 23 | 24 | % done 25 | body 0 (prod N S x\ prod _ _ _) E TisT (fun N S R) :- 26 | @pi-decl N S x\ 27 | R x = {{ lp:E lp:x (lp:TisT lp:x) }}. 28 | 29 | pred main i:inductive, i:string, o:list prop. 30 | main GR O [eqOK-done GR] :- do! [ 31 | T = global (indt GR), 32 | coq.env.indt GR _ Lno _ _ _ _, 33 | 34 | assert! (eqcorrect-db (indt GR) E) "derive.eqOK: use derive.eqcorrect before", 35 | coq.env.typeof {coq.term->gref E} ETy, 36 | 37 | assert! (reali T IsT) "derive.eqOK: use derive.param1 before", 38 | assert! (param1-inhab-db IsT TisT) "derive.eqOK: use derive.param1.inhab before", 39 | 40 | body Lno ETy E TisT NewBo, 41 | %coq.say {coq.term->string NewBo}, 42 | std.assert-ok! (coq.typecheck NewBo NewTy) "derive.eqOK generates illtyped term", 43 | 44 | coq.env.add-const O NewBo NewTy @opaque! _, 45 | coq.elpi.accumulate _ "derive.eqOK.db" (clause _ _ (eqOK-done GR)), 46 | ]. 47 | 48 | } 49 | -------------------------------------------------------------------------------- /apps/derive/elpi/isK.elpi: -------------------------------------------------------------------------------- 1 | /* Derive a function "isK t -> true" iif t is "K .." for K constructor */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | shorten std.{assert!, last, forall, map}. 6 | 7 | namespace derive.isK { 8 | 9 | pred ty i:term, i:list term, i:list term, o:term. 10 | ty _ _ _ {{ bool }}. 11 | 12 | % if the branch of the match (corresponding to KParams) is the one 13 | % for K (the constructor we are generating the isK function for) we say 14 | % true, else we say false. 15 | pred branch i:term, i:term, i:term, i:list term, i:list term, o:term. 16 | branch K KParams _ _ _ {{ true }} :- coq.safe-dest-app KParams K _, !. 17 | branch _ _ _ _ _ {{ false }}. 18 | 19 | pred body i:term, i:term, i:list term, i:list term, o:term. 20 | body K _ Vars Tys R :- 21 | last Vars X, 22 | last Tys TX, 23 | coq.build-match X TX ty (branch K) R. 24 | 25 | pred main-K i:string, i:term, i:term, i:constructor, o:prop. 26 | main-K Prefix Ity Arity GRK Clause :- 27 | K = (global (indc GRK)), 28 | coq.bind-ind-arity Ity Arity (body K) TSek, 29 | std.assert-ok! (coq.elaborate-skeleton TSek Ty T) "derive.isK generates illtyped term", 30 | Name is Prefix ^ {coq.gref->id (indc GRK)}, 31 | coq.env.add-const Name T Ty _ IsK, 32 | Clause = (isK-db GRK (global (const IsK)) :- !). 33 | 34 | pred main i:inductive, i:string, i:list prop. 35 | main GR Prefix Clauses :- 36 | T = global (indt GR), 37 | coq.env.indt GR _ _ _ Arity Kn _, 38 | map Kn (main-K Prefix T Arity) Clauses, 39 | forall Clauses (c\ coq.elpi.accumulate _ "derive.isK.db" (clause _ (before "isK-db:fail") c)). 40 | 41 | } 42 | 43 | % vim: set spelllang=: 44 | -------------------------------------------------------------------------------- /apps/derive/examples/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.derive.examples) 3 | (theories elpi elpi.apps.derive)) 4 | 5 | (include_subdirs qualified) 6 | -------------------------------------------------------------------------------- /apps/derive/examples/readme.v: -------------------------------------------------------------------------------- 1 | (* README *) 2 | From elpi.apps Require Import derive.std. 3 | 4 | #[module] derive Inductive peano := Zero | Succ (p : peano). 5 | 6 | Print peano.peano. 7 | (* Inductive peano : Set := Zero : peano | Succ : peano -> peano. *) 8 | 9 | Eval compute in peano.eqb Zero (Succ Zero). 10 | (* = false : bool *) 11 | 12 | About peano.eqb_OK. 13 | (* 14 | peano.eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (peano.eqb x1 x2) 15 | 16 | peano.eqb_OK is not universe polymorphic 17 | Arguments peano.eqb_OK x1 x2 18 | peano.eqb_OK is opaque 19 | Expands to: Constant elpi.apps.derive.examples.readme.peano.eqb_OK 20 | *) 21 | 22 | #[verbose] derive Nat.add. 23 | Check is_add. (* 24 | : forall n : nat, is_nat n -> 25 | forall m : nat, is_nat m -> 26 | is_nat (n + m) 27 | *) 28 | -------------------------------------------------------------------------------- /apps/derive/tests-stdlib/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (package rocq-elpi-tests-stdlib) 3 | (name elpi_apps_derive_tests_stdlib) 4 | (flags :standard -w -default-output-directory) 5 | (theories elpi elpi.apps.derive elpi.apps.derive.tests elpi_stdlib)) 6 | 7 | (include_subdirs qualified) 8 | -------------------------------------------------------------------------------- /apps/derive/tests/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.derive.tests) 3 | (package rocq-elpi-tests) 4 | (flags :standard -w -default-output-directory) 5 | (theories elpi elpi.apps.derive)) 6 | 7 | (include_subdirs qualified) 8 | -------------------------------------------------------------------------------- /apps/derive/tests/test_eqType_ast.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import derive.eqType_ast. 2 | 3 | From elpi.apps.derive.tests Require Import test_derive_corelib. 4 | Import test_derive_corelib.Coverage. 5 | 6 | Module Coverage. 7 | Elpi derive.eqType.ast empty. 8 | Elpi derive.eqType.ast unit. 9 | Elpi derive.eqType.ast peano. 10 | Elpi derive.eqType.ast option. 11 | Elpi derive.eqType.ast pair. 12 | Elpi derive.eqType.ast seq. 13 | Elpi derive.eqType.ast box_peano. 14 | Elpi derive.eqType.ast rose. 15 | Elpi derive.eqType.ast rose_p. 16 | Elpi derive.eqType.ast rose_o. 17 | Fail Elpi derive.eqType.ast nest. 18 | Fail Elpi derive.eqType.ast w. 19 | Fail Elpi derive.eqType.ast vect. 20 | Fail Elpi derive.eqType.ast dyn. 21 | Fail Elpi derive.eqType.ast zeta. 22 | Elpi derive.eqType.ast beta. 23 | Fail Elpi derive.eqType.ast iota. 24 | Elpi derive.eqType.ast large. 25 | Elpi derive.eqType.ast prim_int. 26 | Fail Elpi derive.eqType.ast prim_float. 27 | Elpi derive.eqType.ast prim_string. 28 | Elpi derive.eqType.ast fo_record. 29 | Elpi derive.eqType.ast pa_record. 30 | Elpi derive.eqType.ast pr_record. 31 | Fail Elpi derive.eqType.ast dep_record. 32 | Elpi derive.eqType.ast enum. 33 | Elpi derive.eqType.ast bool. 34 | Fail Elpi derive.eqType.ast eq. 35 | Elpi derive.eqType.ast sigma_bool. 36 | Elpi derive.eqType.ast sigma_bool2. 37 | Elpi derive.eqType.ast ord. 38 | Elpi derive.eqType.ast ord2. 39 | Elpi derive.eqType.ast val. 40 | End Coverage. 41 | Import Coverage. 42 | 43 | Inductive F1 := | K1 : (peano -> peano) -> F1. 44 | Fail Elpi derive.eqType.ast F1. 45 | 46 | Inductive F2 := | K2 : F1 -> F2. 47 | Fail Elpi derive.eqType.ast F2. 48 | 49 | Inductive S1 (x : F1) := | D1. 50 | Elpi derive.eqType.ast S1. 51 | 52 | 53 | Inductive S2 (x : F1) := | D2 : S1 x -> S2. 54 | Elpi derive.eqType.ast S2. 55 | 56 | Inductive S3 (f : peano -> peano) := | D3 x : f x = x -> S3. 57 | Elpi derive.eqType.ast S3. 58 | 59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /apps/derive/tests/test_eqbOK.v: -------------------------------------------------------------------------------- 1 | From elpi.core Require Import Bool. 2 | From elpi.apps Require Import derive.eqbOK. 3 | 4 | From elpi.apps.derive.tests Require Import test_derive_corelib test_eqb test_eqbcorrect. 5 | 6 | Import test_derive_corelib.Coverage 7 | test_eqType_ast.Coverage 8 | test_eqb.Coverage 9 | test_eqbcorrect.Coverage. 10 | 11 | Module Coverage. 12 | 13 | Elpi derive.eqbOK empty. 14 | Elpi derive.eqbOK unit. 15 | Elpi derive.eqbOK peano. 16 | Elpi derive.eqbOK option. 17 | Elpi derive.eqbOK pair. 18 | Elpi derive.eqbOK seq. 19 | Elpi derive.eqbOK box_peano. 20 | Elpi derive.eqbOK rose. 21 | Elpi derive.eqbOK rose_p. 22 | Elpi derive.eqbOK rose_o. 23 | Fail Elpi derive.eqbOK nest. 24 | Fail Elpi derive.eqbOK w. 25 | Fail Elpi derive.eqbOK vect. 26 | Fail Elpi derive.eqbOK dyn. 27 | Fail Elpi derive.eqbOK zeta. 28 | Elpi derive.eqbOK beta. 29 | Fail Elpi derive.eqbOK iota. 30 | (* 31 | Elpi derive.eqbOK large. 32 | *) 33 | Elpi derive.eqbOK prim_int. 34 | Fail Elpi derive.eqbOK prim_float. 35 | Elpi derive.eqbOK prim_string. 36 | Elpi derive.eqbOK fo_record. 37 | Elpi derive.eqbOK pa_record. 38 | Elpi derive.eqbOK pr_record. 39 | Fail Elpi derive.eqbOK dep_record. 40 | Elpi derive.eqbOK enum. 41 | Fail Elpi derive.eqbOK eq. 42 | Elpi derive.eqbOK bool. 43 | Elpi derive.eqbOK sigma_bool. 44 | Elpi derive.eqbOK sigma_bool2. 45 | Elpi derive.eqbOK ord. 46 | Elpi derive.eqbOK ord2. 47 | Elpi derive.eqbOK val. 48 | Elpi derive.eqbOK alias. 49 | 50 | End Coverage. 51 | 52 | Import Coverage. 53 | 54 | Redirect "tmp" Check peano_eqb_OK : forall n m, Datatypes.reflect (n = m) (peano_eqb n m). 55 | Redirect "tmp" Check seq_eqb_OK : forall A eqA (h : forall a1 a2 : A, Datatypes.reflect (a1 = a2) (eqA a1 a2)) l1 l2, Datatypes.reflect (l1 = l2) (seq_eqb A eqA l1 l2). 56 | Redirect "tmp" Check ord_eqb_OK : forall n (o1 o2 : ord n), Datatypes.reflect (o1 = o2) (ord_eqb n n o1 o2). 57 | Redirect "tmp" Check alias_eqb_OK : forall x y : alias, Datatypes.reflect (x = y) (alias_eqb x y). 58 | -------------------------------------------------------------------------------- /apps/derive/tests/test_idx2inv.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import derive.param1 derive.invert derive.induction derive.idx2inv. 2 | 3 | Elpi derive.param1 list. 4 | Elpi derive.invert is_list. 5 | Elpi derive.idx2inv is_list. 6 | 7 | Redirect "tmp" Check is_list_to_is_list_inv : 8 | forall A PA l, is_list A PA l -> is_list_inv A PA l. -------------------------------------------------------------------------------- /apps/derive/tests/test_invert.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import derive.invert. 2 | 3 | Inductive test A : bool -> Type := 4 | K1 : test true 5 | | K2 : forall x, A -> test (negb x) -> test (negb (negb x)). 6 | 7 | Elpi derive.invert test. 8 | 9 | Redirect "tmp" Check test_inv : Type -> bool -> Type. 10 | Redirect "tmp" Check K1_inv : forall A b, b = true -> test_inv A b. 11 | Redirect "tmp" Check K2_inv : forall A b, forall x, A -> test_inv A (negb x) -> b = negb (negb x) -> test_inv A b. 12 | 13 | Inductive listR A PA : list A -> Type := 14 | | nilR : listR (@nil A) 15 | | consR : forall a : A, PA a -> forall xs : list A, listR xs -> listR (cons a xs). 16 | 17 | Elpi derive.invert listR. 18 | Print listR_inv. -------------------------------------------------------------------------------- /apps/derive/tests/test_lens.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import test_derive_corelib derive.lens. 2 | 3 | Import test_derive_corelib.Coverage. 4 | 5 | (* coverage *) 6 | Module Coverage. 7 | Elpi derive.lens fo_record. 8 | Elpi derive.lens pa_record. 9 | Elpi derive.lens pr_record. 10 | Fail Elpi derive.lens dep_record. 11 | Fail Elpi derive.lens sigma_bool. 12 | End Coverage. 13 | 14 | Import Coverage. 15 | 16 | Redirect "tmp" Check _f1 : Lens fo_record fo_record peano peano. 17 | Redirect "tmp" Check _f2 : Lens fo_record fo_record unit unit. 18 | Redirect "tmp" Check @_f3 : forall A, Lens (pa_record A) (pa_record A) peano peano. 19 | Redirect "tmp" Check @_f4 : forall A, Lens (pa_record A) (pa_record A) A A. 20 | Redirect "tmp" Check @_pf3 : forall A, Lens (pr_record A) (pr_record A) peano peano. 21 | Redirect "tmp" Check @_pf4 : forall A, Lens (pr_record A) (pr_record A) A A. 22 | Goal forall A x, x = @_pf3 A. 23 | intros; unfold _pf3. 24 | match goal with 25 | | |- x = {| over := fun f r => {| pf3 := f (_ r); pf4 := _ r |} ; 26 | view := _ |} 27 | => idtac 28 | | |- _ => fail "not primitive" 29 | end. 30 | Abort. 31 | 32 | #[projections(primitive=yes)] 33 | Record R := MkR { 34 | proj : nat; 35 | }. 36 | 37 | Elpi derive.lens R "R__". 38 | 39 | Lemma failing r : 40 | r.(proj) = 0 -> 41 | view R__proj r = r.(proj). 42 | Proof. 43 | simpl. 44 | intros Hpr. 45 | rewrite Hpr. 46 | reflexivity. 47 | Abort. 48 | 49 | Lemma working r : 50 | match r with MkR r_proj => r_proj end = 0 -> 51 | view R__proj r = match r with MkR r_proj => r_proj end. 52 | Proof. 53 | simpl. 54 | intros Hpr. 55 | rewrite Hpr. 56 | Fail reflexivity. 57 | unfold proj. 58 | rewrite Hpr. 59 | reflexivity. 60 | Qed. 61 | -------------------------------------------------------------------------------- /apps/derive/tests/test_lens_laws.v: -------------------------------------------------------------------------------- 1 | 2 | From elpi.apps Require Import derive.lens_laws. 3 | 4 | From elpi.apps Require Import test_derive_corelib test_lens. 5 | 6 | Import test_derive_corelib.Coverage. 7 | Import test_lens.Coverage. 8 | 9 | (* coverage *) 10 | Module Coverage. 11 | Elpi derive.lens_laws fo_record. 12 | Elpi derive.lens_laws pa_record. 13 | Elpi derive.lens_laws pr_record. 14 | Elpi derive.lens_laws dep_record. 15 | Elpi derive.lens_laws sigma_bool. 16 | End Coverage. 17 | 18 | Import Coverage. 19 | 20 | Redirect "tmp" Check _f1_view_set : view_set _f1. 21 | Redirect "tmp" Check _f2_view_set : view_set _f2. 22 | Redirect "tmp" Check _f3_view_set : forall A, view_set (_f3 A). 23 | Redirect "tmp" Check _f4_view_set : forall A, view_set (_f4 A). 24 | Redirect "tmp" Check _pf3_view_set : forall A, view_set (_pf3 A). 25 | Redirect "tmp" Check _pf4_view_set : forall A, view_set (_pf4 A). 26 | 27 | Redirect "tmp" Check _f1_set_set : set_set _f1. 28 | Redirect "tmp" Check _f2_set_set : set_set _f2. 29 | Redirect "tmp" Check _f3_set_set : forall A, set_set (_f3 A). 30 | Redirect "tmp" Check _f4_set_set : forall A, set_set (_f4 A). 31 | Redirect "tmp" Check _pf3_set_set : forall A, set_set (_pf3 A). 32 | Redirect "tmp" Check _pf4_set_set : forall A, set_set (_pf4 A). 33 | 34 | Redirect "tmp" Check _f1_set_view : set_view _f1. 35 | Redirect "tmp" Check _f2_set_view : set_view _f2. 36 | Redirect "tmp" Check _f3_set_view : forall A, set_view (_f3 A). 37 | Redirect "tmp" Check _f4_set_view : forall A, set_view (_f4 A). 38 | Redirect "tmp" Check _pf3_set_view : forall A, set_view (_pf3 A). 39 | Redirect "tmp" Check _pf4_set_view : forall A, set_view (_pf4 A). 40 | 41 | Redirect "tmp" Check _f1_f2_exchange : exchange _f1 _f2. 42 | Redirect "tmp" Check _f2_f1_exchange : exchange _f2 _f1. 43 | Redirect "tmp" Check _f3_f4_exchange : forall A, exchange (_f3 A) (_f4 A). 44 | Redirect "tmp" Check _f4_f3_exchange : forall A, exchange (_f4 A) (_f3 A). 45 | Redirect "tmp" Check _pf3_pf4_exchange : forall A, exchange (_pf3 A) (_pf4 A). 46 | Redirect "tmp" Check _pf4_pf3_exchange : forall A, exchange (_pf4 A) (_pf3 A). 47 | 48 | -------------------------------------------------------------------------------- /apps/derive/tests/test_map.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import derive.map. 2 | 3 | From elpi.apps.derive.tests Require Import test_derive_corelib. 4 | Import test_derive_corelib.Coverage. 5 | 6 | Module Coverage. 7 | 8 | Elpi derive.map empty. 9 | Elpi derive.map unit. 10 | Elpi derive.map peano. 11 | Elpi derive.map option. 12 | Elpi derive.map pair. 13 | Elpi derive.map seq. 14 | Elpi derive.map box_peano. 15 | Elpi derive.map rose. 16 | Elpi derive.map rose_p. 17 | Elpi derive.map rose_o. 18 | Fail Elpi derive.map nest. 19 | Fail Elpi derive.map w. 20 | Elpi derive.map vect. 21 | Elpi derive.map dyn. 22 | Elpi derive.map zeta. 23 | Fail Elpi derive.map beta. 24 | Elpi derive.map iota. 25 | Elpi derive.map large. 26 | Elpi derive.map prim_int. 27 | Elpi derive.map prim_float. 28 | Elpi derive.map fo_record. 29 | Elpi derive.map pa_record. 30 | Elpi derive.map pr_record. 31 | Elpi derive.map dep_record. 32 | Elpi derive.map enum. 33 | Fail Elpi derive.map eq. 34 | Elpi derive.map bool. 35 | Elpi derive.map sigma_bool. 36 | Elpi derive.map sigma_bool2. 37 | Fail Elpi derive.map ord. 38 | Elpi derive.map val. 39 | End Coverage. 40 | 41 | Import Coverage. 42 | 43 | Local Notation map T := (T -> T). 44 | Local Notation map1 T := (forall X Y, (X -> Y) -> T X%type -> T Y%type). 45 | 46 | Redirect "tmp" Check empty_map : map empty. 47 | Redirect "tmp" Check unit_map : map unit. 48 | Redirect "tmp" Check peano_map : map peano. 49 | Redirect "tmp" Check option_map : map1 option. 50 | Redirect "tmp" Check pair_map : forall A B (f : A -> B) C D (g : C -> D), (pair A C) -> (pair B D). 51 | Redirect "tmp" Check seq_map : map1 seq. 52 | Redirect "tmp" Check rose_map : map1 rose. 53 | Fail Check nest_map. 54 | Fail Check w_map. 55 | Redirect "tmp" Check vect_map : forall A B (f : A -> B) i, vect A i -> vect B i. 56 | Redirect "tmp" Check dyn_map : map dyn. 57 | Redirect "tmp" Check zeta_map : forall A B (f : A -> B), zeta A -> zeta B. 58 | Fail Check beta_map. 59 | Redirect "tmp" Check iota_map : map iota. 60 | Redirect "tmp" Check large_map : map large. 61 | Redirect "tmp" Check prim_int_map : map prim_int. 62 | Redirect "tmp" Check prim_float_map : map prim_float. 63 | Redirect "tmp" Check pa_record_map : map1 pa_record. 64 | Redirect "tmp" Check pr_record_map : map1 pr_record. 65 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/cast.v: -------------------------------------------------------------------------------- 1 | (* Generates (once and forall) cast operators (trasport). 2 | 3 | license: GNU Lesser General Public License Version 2.1 or later 4 | ------------------------------------------------------------------------- *) 5 | 6 | From elpi.apps.derive.elpi Extra Dependency "cast.elpi" as cast. 7 | 8 | From elpi Require Export elpi. 9 | 10 | Elpi Db derive.cast.db lp:{{ type cast-db int -> term -> prop. }}. 11 | 12 | 13 | Elpi Command derive.cast. 14 | Elpi Accumulate Db derive.cast.db. 15 | Elpi Accumulate File cast. 16 | Elpi Accumulate lp:{{ 17 | 18 | main [int N] :- 19 | derive.cast.main N. 20 | 21 | }}. 22 | 23 | 24 | 25 | Elpi derive.cast 2. 26 | Elpi derive.cast 3. 27 | Elpi derive.cast 4. 28 | Elpi derive.cast 5. 29 | Elpi derive.cast 6. 30 | Elpi derive.cast 7. 31 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/eqOK.v: -------------------------------------------------------------------------------- 1 | (* Generates the final, correctness lemma, for equality tests by combinig the 2 | output of eqcorrect and param1_inhab. 3 | 4 | license: GNU Lesser General Public License Version 2.1 or later 5 | ------------------------------------------------------------------------- *) 6 | From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. 7 | From elpi.apps.derive.elpi Extra Dependency "param1.elpi" as param1. 8 | From elpi.apps.derive.elpi Extra Dependency "eqOK.elpi" as eqOK. 9 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 10 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 11 | 12 | From elpi Require Import elpi. 13 | From elpi.apps Require Import derive. 14 | From elpi.apps Require Import derive.param1 derive.param1_congr derive.param1_trivial derive.eqK derive.eqcorrect. 15 | 16 | Elpi Db derive.eqOK.db lp:{{ 17 | pred eqOK-done i:inductive. 18 | }}. 19 | 20 | 21 | (* standalone *) 22 | Elpi Command derive.eqOK. 23 | Elpi Accumulate File derive_hook. 24 | Elpi Accumulate File paramX. 25 | Elpi Accumulate File param1. 26 | Elpi Accumulate Db derive.param1.db. 27 | Elpi Accumulate Db derive.param1.trivial.db. 28 | Elpi Accumulate Db derive.eqcorrect.db. 29 | Elpi Accumulate Db derive.eqOK.db. 30 | 31 | Elpi Accumulate File eqOK. 32 | Elpi Accumulate lp:{{ 33 | main [str I, str O] :- !, coq.locate I (indt GR), derive.eqOK.main GR O _. 34 | main [str I] :- !, 35 | coq.locate I (indt GR), Name is {coq.gref->id (indt GR)} ^ "_eq_OK", 36 | derive.eqOK.main GR Name _. 37 | main _ :- usage. 38 | 39 | usage :- 40 | coq.error "Usage: derive.eqOK []". 41 | }}. 42 | 43 | 44 | 45 | (* hook into derive *) 46 | Elpi Accumulate derive File eqOK. 47 | Elpi Accumulate derive Db derive.eqOK.db. 48 | 49 | #[phases="both"] Elpi Accumulate derive lp:{{ 50 | dep1 "eqOK" "eqcorrect". 51 | dep1 "eqOK" "param1_trivial". 52 | }}. 53 | 54 | #[synterp] Elpi Accumulate derive lp:{{ 55 | derivation _ _ (derive "eqOK" (cl\ cl = []) true). 56 | }}. 57 | 58 | Elpi Accumulate derive lp:{{ 59 | 60 | derivation (indt T) Prefix ff (derive "eqOK" (derive.eqOK.main T N) (eqOK-done T)) :- N is Prefix ^ "eq_OK". 61 | 62 | }}. 63 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/eqOK_trivial.v.skip: -------------------------------------------------------------------------------- 1 | (* Draft: trivil eq_axiom (needed for indexes) 2 | 3 | license: GNU Lesser General Public License Version 2.1 or later 4 | ------------------------------------------------------------------------- *) 5 | 6 | From mathcomp Require Import all_ssreflect. 7 | From elpi.apps Require Import elpi. 8 | 9 | Definition transp {T} (Ctx : T -> Type) {t1 t2} (e : t2 = t1) : Ctx t1 -> Ctx t2. 10 | Proof. by case: _/e. Defined. 11 | 12 | Axiom dep_fun_ext : forall T (P : T -> Type) (f g: forall t:T, P t), (forall x, f x = g x) -> f = g. 13 | 14 | Lemma reflect_irrelevance (T : eqType) (x y : T) b (p1 p2 : reflect (x = y) b) : p1 = p2. 15 | Proof. 16 | case: p2 p1 => {b} [e| ne] r. 17 | refine (match r as r in reflect _ t 18 | return forall p : t = true, r = 19 | transp (reflect (x = y)) p (ReflectT (x = y) e) with 20 | | ReflectT e' => _ 21 | | ReflectF ne' => _ 22 | end (erefl true)) => // p {r}. 23 | rewrite (eq_irrelevance p (erefl true)) {p}. 24 | congr (ReflectT (x = y)). 25 | by apply: eq_irrelevance. 26 | refine (match r as r in reflect _ t 27 | return forall p : t = false, r = 28 | transp (reflect (x = y)) p (ReflectF (x = y) ne) with 29 | | ReflectT e' => _ 30 | | ReflectF ne' => _ 31 | end (erefl false)) => // p {r}. 32 | rewrite (eq_irrelevance p (erefl false)) {p}. 33 | congr (ReflectF (x = y)). 34 | apply: dep_fun_ext. 35 | by case/ne. 36 | Qed. 37 | 38 | Lemma eq_axiom_trivial (a : eqType) fa : 39 | full a (eq_axiom a fa) -> trivial a (eq_axiom a fa). 40 | Proof. 41 | rewrite /eq_axiom /full. 42 | move=> p1 x; exists (p1 x) => p2. 43 | apply: dep_fun_ext => w. 44 | apply: reflect_irrelevance. 45 | Qed. 46 | 47 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/experimental.v: -------------------------------------------------------------------------------- 1 | (* Experimental set of derivations 2 | 3 | license: GNU Lesser General Public License Version 2.1 or later 4 | ------------------------------------------------------------------------- *) 5 | 6 | From elpi.apps Require Export derive. 7 | From elpi.apps Require Export 8 | derive.invert 9 | derive.idx2inv 10 | . 11 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/idx2inv.v: -------------------------------------------------------------------------------- 1 | (* Generates lemmas linking an inductive with indexes and its structural 2 | copy without indexes but equations instead. 3 | 4 | license: GNU Lesser General Public License Version 2.1 or later 5 | ------------------------------------------------------------------------- *) 6 | From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. 7 | From elpi.apps.derive.elpi Extra Dependency "param1_functor.elpi" as param1_functor. 8 | From elpi.apps.derive.elpi Extra Dependency "idx2inv.elpi" as idx2inv. 9 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 10 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 11 | 12 | From elpi Require Export elpi. 13 | From elpi.apps Require Export derive. 14 | From elpi.apps Require Export derive.param1 derive.param1_functor derive.invert. 15 | 16 | Elpi Db derive.idx2inv.db lp:{{ 17 | type idx2inv-db inductive -> inductive -> constant -> constant -> prop. 18 | }}. 19 | 20 | (* standalone *) 21 | Elpi Command derive.idx2inv. 22 | Elpi Accumulate File derive_hook. 23 | Elpi Accumulate File paramX. 24 | Elpi Accumulate Db derive.param1.db. 25 | Elpi Accumulate Db derive.param1.functor.db. 26 | Elpi Accumulate File param1_functor. 27 | Elpi Accumulate Db derive.invert.db. 28 | Elpi Accumulate Db derive.idx2inv.db. 29 | Elpi Accumulate File idx2inv. 30 | Elpi Accumulate lp:{{ 31 | main [str I, str O] :- !, coq.locate I (indt GR), derive.idx2inv.main GR O _. 32 | main [str I] :- !, coq.locate I (indt GR), derive.idx2inv.main GR "_to_" _. 33 | main _ :- usage. 34 | 35 | usage :- coq.error "Usage: derive.idx2inv []". 36 | }}. 37 | 38 | 39 | (* hook into derive *) 40 | Elpi Accumulate derive Db derive.idx2inv.db. 41 | Elpi Accumulate derive File idx2inv. 42 | Elpi Accumulate File paramX. 43 | 44 | #[phases="both"] Elpi Accumulate derive lp:{{ 45 | dep1 "idx2inv" "invert". 46 | }}. 47 | 48 | #[synterp] Elpi Accumulate derive lp:{{ 49 | derivation _ _ (derive "idx2inv" (cl\ cl = []) true). 50 | }}. 51 | 52 | Elpi Accumulate derive lp:{{ 53 | 54 | derivation (indt T) _ ff (derive "idx2inv" (derive.idx2inv.main T "_to_") (idx2inv-db T _ _ _)). 55 | 56 | }}. 57 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/invert.v: -------------------------------------------------------------------------------- 1 | (* Generates inversion lemmas by encoding indexes with equations and non 2 | uniform parameters. 3 | 4 | license: GNU Lesser General Public License Version 2.1 or later 5 | ------------------------------------------------------------------------- *) 6 | From elpi.apps.derive.elpi Extra Dependency "invert.elpi" as invert. 7 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 8 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 9 | 10 | From elpi Require Export elpi. 11 | From elpi.apps Require Export derive. 12 | 13 | Elpi Db derive.invert.db lp:{{ type invert-db gref -> gref -> prop. }}. 14 | 15 | Elpi Command derive.invert. 16 | Elpi Accumulate Db derive.invert.db. 17 | Elpi Accumulate File invert. 18 | Elpi Accumulate lp:{{ 19 | main [str I, str O] :- !, coq.locate I (indt GR), derive.invert.main GR O _. 20 | main [str I] :- !, coq.locate I (indt GR), derive.invert.main GR "_inv" _. 21 | main _ :- usage. 22 | 23 | usage :- coq.error "Usage: derive.invert []". 24 | }}. 25 | 26 | 27 | (* hook into derive *) 28 | Elpi Accumulate derive File invert. 29 | Elpi Accumulate derive Db derive.invert.db. 30 | 31 | #[synterp] Elpi Accumulate derive lp:{{ 32 | derivation _ _ (derive "invert" (cl\ cl = []) true). 33 | }}. 34 | 35 | Elpi Accumulate derive lp:{{ 36 | 37 | derivation (indt T) Prefix ff (derive "invert" (derive.invert.main T N) (invert-db (indt T) _)) :- N is Prefix ^ "inv". 38 | 39 | }}. 40 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/isK.v: -------------------------------------------------------------------------------- 1 | (* For each constructor K the function isK returns true iff it is applied 2 | to K. These helpers are use to implement "discriminate". 3 | 4 | license: GNU Lesser General Public License Version 2.1 or later 5 | ------------------------------------------------------------------------- *) 6 | From elpi.apps.derive.elpi Extra Dependency "isK.elpi" as isK. 7 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 8 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 9 | 10 | From elpi Require Import elpi. 11 | From elpi.apps Require Import derive. 12 | 13 | (* Links the @gref of the constructor K to the isK constant *) 14 | Elpi Db derive.isK.db lp:{{ 15 | type isK-db constructor -> term -> prop. 16 | }}. 17 | #[superglobal] Elpi Accumulate derive.isK.db File derive.lib. 18 | #[superglobal] Elpi Accumulate derive.isK.db lp:{{ 19 | 20 | :name "isK-db:fail" 21 | isK-db K _ :- 22 | M is "No isK entry for constructor " ^ {std.any->string K} ^ ". Did you run derive.isK?", 23 | stop M. 24 | 25 | }}. 26 | 27 | Elpi Command derive.isK. 28 | Elpi Accumulate File derive_hook. 29 | Elpi Accumulate Db derive.isK.db. 30 | Elpi Accumulate File isK. 31 | Elpi Accumulate lp:{{ 32 | main [str I,str O] :- !, coq.locate I (indt GR), derive.isK.main GR O _. 33 | main [str I] :- !, 34 | coq.locate I (indt GR), 35 | Prefix is {coq.gref->id (indt GR)} ^ "_is_", 36 | derive.isK.main GR Prefix _. 37 | main _ :- usage. 38 | 39 | usage :- 40 | coq.error "Usage: derive.isK []". 41 | }}. 42 | 43 | 44 | (* hook into derive *) 45 | Elpi Accumulate derive Db derive.isK.db. 46 | Elpi Accumulate derive File isK. 47 | 48 | #[synterp] Elpi Accumulate derive lp:{{ 49 | derivation _ _ (derive "isK" (cl\ cl = []) true). 50 | }}. 51 | 52 | Elpi Accumulate derive lp:{{ 53 | 54 | derivation (indt T) Prefix ff (derive "isK" (derive.isK.main T N) (derive.exists-indc T (K\ isK-db K _))) :- N is Prefix ^ "isk_". 55 | 56 | }}. 57 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/legacy.v: -------------------------------------------------------------------------------- 1 | (* Legacy set of derivations 2 | 3 | license: GNU Lesser General Public License Version 2.1 or later 4 | ------------------------------------------------------------------------- *) 5 | 6 | From elpi.apps Require Export derive. 7 | From elpi.apps Require Export 8 | derive.projK 9 | derive.isK 10 | derive.eq 11 | derive.eqK 12 | derive.bcongr 13 | derive.eqOK 14 | . 15 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/lens.v: -------------------------------------------------------------------------------- 1 | (* A lens, to see better. 2 | 3 | license: GNU Lesser General Public License Version 2.1 or later 4 | ------------------------------------------------------------------------- *) 5 | From elpi.apps.derive.elpi Extra Dependency "lens.elpi" as lens. 6 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 7 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 8 | 9 | From elpi Require Import elpi. 10 | From elpi.apps Require Import derive. 11 | 12 | (* Coq stdlib has no lens data type so we declare one here. To override with 13 | your own "copy", use Register as below *) 14 | Local Set Primitive Projections. 15 | Record Lens (a b c d : Type) : Type := mkLens 16 | { view : a -> c 17 | ; over : (c -> d) -> a -> b 18 | }. 19 | Register mkLens as elpi.derive.lens.make. 20 | 21 | Arguments view {_ _ _ _} _ _. 22 | Arguments over {_ _ _ _} _ _ _. 23 | 24 | Definition set {a b c d} (l : Lens a b c d) new := over l (fun _ => new). 25 | Register set as elpi.derive.lens.set. 26 | Register view as elpi.derive.lens.view. 27 | 28 | (* Links the record, a field name and the lens focusing on that field *) 29 | Elpi Db derive.lens.db lp:{{ 30 | pred lens-db o:inductive, o:string, o:constant. 31 | }}. 32 | 33 | (* standalone command *) 34 | Elpi Command derive.lens. 35 | Elpi Accumulate Db Header derive.lens.db. 36 | Elpi Accumulate File derive_hook. 37 | Elpi Accumulate File lens. 38 | Elpi Accumulate Db derive.lens.db. 39 | Elpi Accumulate lp:{{ 40 | main [str I, str O] :- !, coq.locate I (indt GR), derive.lens.main GR O _. 41 | main [str I] :- !, coq.locate I (indt GR), derive.lens.main GR "_" _. 42 | main _ :- usage. 43 | 44 | usage :- coq.error "Usage: derive.lens []". 45 | }}. 46 | 47 | 48 | (* hook into derive *) 49 | Elpi Accumulate derive Db derive.lens.db. 50 | Elpi Accumulate derive File lens. 51 | 52 | #[synterp] Elpi Accumulate derive lp:{{ 53 | derivation _ _ (derive "lens" (cl\ cl = []) true). 54 | }}. 55 | 56 | Elpi Accumulate derive lp:{{ 57 | derivation (indt T) Prefix ff (derive "lens" (derive.lens.main T N) (lens-db T _ _)) :- N is Prefix ^ "_". 58 | }}. 59 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/map.v: -------------------------------------------------------------------------------- 1 | (* A map over a container. For non containers it produces the copy function. 2 | 3 | license: GNU Lesser General Public License Version 2.1 or later 4 | ------------------------------------------------------------------------- *) 5 | From elpi.apps.derive.elpi Extra Dependency "map.elpi" as map. 6 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 7 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 8 | 9 | From elpi Require Import elpi. 10 | From elpi.apps Require Import derive. 11 | 12 | (* Links the source and target type with the corresponding map function, 13 | eg. "map-db (list A) (list B) (list_map f_A_B)" 14 | *) 15 | Elpi Db derive.map.db lp:{{ 16 | pred map-done i:inductive. 17 | pred map-db i:term, i:term, o:term. 18 | }}. 19 | 20 | (* standalone command *) 21 | Elpi Command derive.map. 22 | Elpi Accumulate File derive_hook. 23 | Elpi Accumulate Db derive.map.db. 24 | Elpi Accumulate File map. 25 | Elpi Accumulate lp:{{ 26 | main [str I] :- !, 27 | coq.locate I (indt GR), O is {coq.gref->id (indt GR)} ^ "_", 28 | derive.map.main GR O _. 29 | main _ :- usage. 30 | 31 | usage :- coq.error "Usage: derive.map ". 32 | }}. 33 | 34 | 35 | (* hook into derive *) 36 | Elpi Accumulate derive Db derive.map.db. 37 | Elpi Accumulate derive File map. 38 | 39 | #[synterp] Elpi Accumulate derive lp:{{ 40 | derivation _ _ (derive "map" (cl\ cl = []) true). 41 | }}. 42 | 43 | Elpi Accumulate derive lp:{{ 44 | derivation (indt T) N ff (derive "map" (derive.map.main T N) (map-done T)). 45 | }}. 46 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/param1_congr.v: -------------------------------------------------------------------------------- 1 | (* Given an inductive type I and its unary parametricity translation is_I it 2 | generates for is constructor is_K a lemma like 3 | px = qx -> is_K x px .. = is_K x qx .. 4 | where px is the extra argument (about x) introduces by the parametricity 5 | translation. 6 | 7 | license: GNU Lesser General Public License Version 2.1 or later 8 | ------------------------------------------------------------------------- *) 9 | From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. 10 | From elpi.apps.derive.elpi Extra Dependency "param1_congr.elpi" as param1_congr. 11 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 12 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 13 | 14 | From elpi Require Export elpi. 15 | From elpi.apps Require Export derive.param1. 16 | 17 | Elpi Db derive.param1.congr.db lp:{{ 18 | type param1-congr-db constructor -> term -> prop. 19 | }}. 20 | 21 | Elpi Command derive.param1.congr. 22 | Elpi Accumulate File paramX. 23 | Elpi Accumulate Db derive.param1.congr.db. 24 | Elpi Accumulate File param1_congr. 25 | Elpi Accumulate lp:{{ 26 | main [str I, str O] :- !, coq.locate I (indt GR), derive.param1.congr.main GR O _. 27 | main [str I] :- !, coq.locate I (indt GR), derive.param1.congr.main GR "congr_" _. 28 | main _ :- usage. 29 | 30 | usage :- 31 | coq.error "Usage: derive.param1.congr []". 32 | }}. 33 | 34 | 35 | (* hook into derive *) 36 | Elpi Accumulate derive File param1_congr. 37 | Elpi Accumulate derive Db derive.param1.congr.db. 38 | 39 | #[phases="both"] Elpi Accumulate derive lp:{{ 40 | dep1 "param1_congr" "param1". 41 | }}. 42 | 43 | #[synterp] Elpi Accumulate derive lp:{{ 44 | derivation _ _ (derive "param1_congr" (cl\ cl = []) true). 45 | }}. 46 | 47 | Elpi Accumulate derive lp:{{ 48 | 49 | derivation (indt T) _ ff (derive "param1_congr" (derive.on_param1 T derive.param1.congr.main "congr_") (derive.on_param1 T (T\_\_\derive.exists-indc T (K\ param1-congr-db K _)) _ _)). 50 | 51 | }}. 52 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/param1_functor.v: -------------------------------------------------------------------------------- 1 | (* Functorial property of params in param1 translation. 2 | Inductive I A PA : A -> Type := K : forall a b, I A PA a. 3 | Elpi derive.param1.functor is_I. 4 | Definition is_I_functor A PA PB (f : forall x, PA x -> PB x) a : 5 | I A PA a -> I A PB a. 6 | 7 | license: GNU Lesser General Public License Version 2.1 or later 8 | ------------------------------------------------------------------------- *) 9 | From elpi.apps.derive.elpi Extra Dependency "param1_functor.elpi" as param1_functor. 10 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 11 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 12 | 13 | From elpi Require Import elpi. 14 | From elpi.apps Require Import derive derive.param1. 15 | 16 | Elpi Db derive.param1.functor.db lp:{{ 17 | pred param1-functor-db i:term, i:term, o:term. 18 | pred param1-functor-for i:inductive, o:gref, o:list bool. 19 | }}. 20 | 21 | Elpi Command derive.param1.functor. 22 | Elpi Accumulate File derive_hook. 23 | Elpi Accumulate Db derive.param1.functor.db. 24 | Elpi Accumulate File param1_functor. 25 | Elpi Accumulate lp:{{ 26 | main [str I, str O] :- !, coq.locate I (indt GR), derive.param1.functor.main GR O _. 27 | main [str I] :- !, coq.locate I (indt GR), derive.param1.functor.main GR "_functor" _. 28 | main _ :- usage. 29 | 30 | usage :- coq.error "Usage: derive.param1.functor []". 31 | }}. 32 | 33 | 34 | (* hook into derive *) 35 | Elpi Accumulate derive File param1_functor. 36 | Elpi Accumulate derive Db derive.param1.functor.db. 37 | 38 | #[phases="both"] Elpi Accumulate derive lp:{{ 39 | dep1 "param1_functor" "param1". 40 | }}. 41 | 42 | #[synterp] Elpi Accumulate derive lp:{{ 43 | derivation _ _ (derive "param1_functor" (cl\ cl = []) true). 44 | }}. 45 | 46 | Elpi Accumulate derive lp:{{ 47 | 48 | derivation (indt T) _ ff (derive "param1_functor" (derive.on_param1 T derive.param1.functor.main "_functor") (derive.on_param1 T (T\_\_\param1-functor-for T _ _) _ _)). 49 | 50 | }}. 51 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/projK.v: -------------------------------------------------------------------------------- 1 | (* Generates a projection for each argument of each constructor. 2 | 3 | The projection is expected to be applied to an explicit construcor and all 4 | its arguments. It is used to implement "injection". 5 | 6 | license: GNU Lesser General Public License Version 2.1 or later 7 | ------------------------------------------------------------------------- *) 8 | From elpi.apps.derive.elpi Extra Dependency "projK.elpi" as projK. 9 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 10 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 11 | 12 | From elpi Require Import elpi. 13 | From elpi.apps Require Import derive. 14 | 15 | Elpi Db derive.projK.db lp:{{ 16 | type projK-db constructor -> int -> term -> prop. 17 | }}. 18 | #[superglobal] Elpi Accumulate derive.projK.db File derive.lib. 19 | #[superglobal] Elpi Accumulate derive.projK.db lp:{{ 20 | 21 | :name "projK-db:fail" 22 | projK-db GR N _ :- 23 | M is "derive.projK: can't find the projection " ^ {std.any->string N} ^ " for constructor " ^ {std.any->string GR}, 24 | stop M. 25 | 26 | }}. 27 | 28 | Elpi Command derive.projK. 29 | Elpi Accumulate File derive_hook. 30 | Elpi Accumulate Db derive.projK.db. 31 | Elpi Accumulate File projK. 32 | Elpi Accumulate lp:{{ 33 | main [str I, str O] :- !, coq.locate I (indt GR), derive.projK.main GR O _. 34 | main [str I] :- !, coq.locate I (indt GR), derive.projK.main GR "proj" _. 35 | main _ :- usage. 36 | 37 | usage :- 38 | coq.error "Usage: derive.projK []". 39 | }}. 40 | 41 | 42 | 43 | (* hook into derive *) 44 | Elpi Accumulate derive File projK. 45 | Elpi Accumulate derive Db derive.projK.db. 46 | 47 | #[synterp] Elpi Accumulate derive lp:{{ 48 | derivation _ _ (derive "projK" (cl\ cl = []) true). 49 | }}. 50 | 51 | Elpi Accumulate derive lp:{{ 52 | 53 | derivation (indt T) Prefix ff (derive "projK" (derive.projK.main T N) (derive.exists-indc T (K\ projK-db K _ _))) :- N is Prefix ^ "getk_". 54 | 55 | }}. 56 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/std.v: -------------------------------------------------------------------------------- 1 | (* Standard set of derivations 2 | 3 | license: GNU Lesser General Public License Version 2.1 or later 4 | ------------------------------------------------------------------------- *) 5 | 6 | From elpi.apps Require Export derive. 7 | From elpi.apps Require Export 8 | derive.map 9 | derive.lens 10 | derive.lens_laws 11 | derive.param1 12 | derive.param1_congr 13 | derive.param1_trivial 14 | derive.param1_functor 15 | derive.param2 16 | derive.induction 17 | derive.tag 18 | derive.fields 19 | derive.eqb 20 | derive.eqbcorrect 21 | derive.eqbOK 22 | . 23 | 24 | (* we derive the Coq prelude *) 25 | 26 | Module Prelude. 27 | derive Init.Datatypes.Empty_set. 28 | derive Init.Datatypes.unit. 29 | derive Init.Datatypes.bool. 30 | derive Init.Datatypes.nat. 31 | derive Init.Datatypes.option. 32 | derive Init.Datatypes.sum. 33 | derive Init.Datatypes.prod. 34 | derive Init.Datatypes.list. 35 | derive Init.Datatypes.comparison. 36 | End Prelude. 37 | 38 | Export Prelude. 39 | -------------------------------------------------------------------------------- /apps/derive/theories/derive/tag.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | From elpi.apps Require Import derive. 3 | From elpi.core Require Import PosDef. 4 | From elpi.apps.derive.elpi Extra Dependency "tag.elpi" as tag. 5 | From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. 6 | From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. 7 | 8 | Register positive as elpi.derive.positive. 9 | 10 | Local Open Scope positive_scope. 11 | 12 | Elpi Db derive.tag.db lp:{{ 13 | 14 | % this is how one registers the tag function to an inductive and let other 15 | % elpi commands use that piece of info 16 | pred tag-for o:inductive, o:constant. 17 | 18 | }}. 19 | 20 | (* standalone *) 21 | Elpi Command derive.tag. 22 | Elpi Accumulate Db Header derive.tag.db. 23 | Elpi Accumulate File derive_hook. 24 | Elpi Accumulate File tag. 25 | Elpi Accumulate Db derive.tag.db. 26 | Elpi Accumulate lp:{{ 27 | 28 | main [str I] :- !, 29 | coq.locate I (indt GR), 30 | coq.gref->id (indt GR) Tname, 31 | Prefix is Tname ^ "_", 32 | derive.tag.main GR Prefix _. 33 | 34 | main _ :- usage. 35 | 36 | usage :- coq.error "Usage: derive.tag ". 37 | 38 | }}. 39 | 40 | 41 | (* hook into derive *) 42 | Elpi Accumulate derive Db derive.tag.db. 43 | Elpi Accumulate derive File tag. 44 | 45 | #[synterp] Elpi Accumulate derive lp:{{ 46 | derivation _ _ (derive "tag" (cl\ cl = []) true). 47 | }}. 48 | 49 | Elpi Accumulate derive lp:{{ 50 | 51 | derivation (indt T) Prefix ff (derive "tag" (derive.tag.main T Prefix) (tag-for T _)). 52 | 53 | }}. 54 | -------------------------------------------------------------------------------- /apps/derive/theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.derive) 3 | (package rocq-elpi) 4 | (theories elpi elpi.apps.derive.elpi)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/eltac/examples/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.eltac.examples) 3 | (theories elpi elpi.apps.eltac)) 4 | 5 | (include_subdirs qualified) 6 | -------------------------------------------------------------------------------- /apps/eltac/examples/usage_eltac.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import derive. 2 | From elpi.apps Require Import eltac.tactics. 3 | 4 | derive nat. 5 | 6 | Lemma example : forall x y : nat, S x = S y -> 0 = 1 -> False. 7 | Proof. 8 | eltac.intro "x". 9 | eltac.intro "y". 10 | eltac.intro "I". 11 | eltac.intro "D". 12 | eltac.injection I. 13 | eltac.intro "E". 14 | eltac.clear E. 15 | eltac.discriminate D. 16 | Qed. -------------------------------------------------------------------------------- /apps/eltac/tests-stdlib/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (package rocq-elpi-tests-stdlib) 3 | (name elpi_apps_eltac_tests_stdlib) 4 | (theories elpi elpi.apps.eltac elpi_stdlib)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/eltac/tests-stdlib/test_injection.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.injection. 2 | 3 | Set Implicit Arguments. 4 | 5 | Elpi derive.projK nat. 6 | 7 | Lemma test_nat (a b :nat) : S a = S b -> a = b. 8 | Proof. 9 | intro H. 10 | eltac.injection (H). 11 | intro E. 12 | assumption. 13 | Qed. 14 | 15 | Require Vector. 16 | Require Import ssreflect Arith. 17 | 18 | Elpi derive.projK Vector.t. 19 | 20 | 21 | Lemma test_vect A a b n (v1 v2 : Vector.t A n) : 22 | Vector.cons A a n v1 = Vector.cons A b n v2 -> a = b /\ v1 = v2. 23 | Proof. 24 | intro H. 25 | eltac.injection (H). 26 | move=> /= Eab _ Esigv12. 27 | split. 28 | exact Eab. 29 | rewrite -[v2](projT2_eq Esigv12) /=. 30 | by rewrite (UIP_nat _ _ (projT1_eq Esigv12) (eq_refl n)). 31 | Qed. -------------------------------------------------------------------------------- /apps/eltac/tests/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.eltac.tests) 3 | (package rocq-elpi-tests) 4 | (theories elpi elpi.apps.eltac)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_apply.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.apply. 2 | Goal (forall (x y : nat), x + y = y + x) -> (forall y, 3 + y = y + 3). 3 | Proof. 4 | intro H. 5 | eltac.apply H. 6 | Qed. 7 | 8 | Axiom add_comm : forall x y, x + y = y + x. 9 | 10 | Goal (3 + 4 = 4 + 3). 11 | Proof. 12 | eltac.apply add_comm. 13 | Qed. 14 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_assumption.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.assumption. 2 | 3 | Lemma test1 x (H : x = 0) : x = 0. 4 | Proof. 5 | eltac.assumption. 6 | Qed. 7 | 8 | Example test_assumption : True -> True. 9 | Proof. 10 | intro x. 11 | eltac.assumption. 12 | Qed. 13 | 14 | 15 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_case.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.case. 2 | 3 | Lemma test1 (n : nat) : n = n. 4 | Proof. 5 | eltac.case n. 6 | exact (refl_equal 0). 7 | exact (refl_equal (S _)). 8 | Qed. 9 | 10 | Inductive is_even : nat -> Prop := 11 | | even0 : is_even 0 12 | | evenS : forall x, is_even x -> is_even (S (S x)). 13 | 14 | Lemma test2 (n : nat) (H : is_even n) : n = n. 15 | Proof. 16 | eltac.case H. 17 | exact (refl_equal 0). 18 | exact (refl_equal (S (S _))). 19 | Qed. 20 | 21 | Axiom q : nat -> Prop. 22 | Axiom p0 : q 0. 23 | 24 | (* The last 0 must not be abstracted or the goal is illtyped *) 25 | Lemma test3 (H : is_even 0) : 0 = 0 /\ (@eq (q 0) p0 p0). 26 | Proof. 27 | eltac.case H. 28 | split. exact (refl_equal 0). exact (refl_equal p0). 29 | split; [ exact (refl_equal (S (S _))) | exact (refl_equal p0) ]. 30 | Qed. 31 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_clear.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.clear. 2 | 3 | Example test_generalize_dependent x y (H : x = y) (H1 : 0 <= x) (d := x + 1) (H2 : y = 1) (w := 3): x + d + y = 2. 4 | Proof. 5 | generalize dependent x. 6 | Fail eltac.clear x. 7 | eltac.clear H2. 8 | Fail match goal with Hyp : y = 1 |- _ => idtac end. 9 | intros. 10 | eltac.clearbody d w. 11 | Fail unfold d. 12 | Check d. 13 | Abort. 14 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_constructor.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.constructor. 2 | 3 | Lemma test1 : 1 = 1. 4 | Proof. 5 | eltac.constructor. 6 | Qed. 7 | 8 | Example test_constructor : Type -> True * Type. 9 | Proof. 10 | intro x. 11 | eltac.constructor. 12 | - eltac.constructor. 13 | - try eltac.constructor. 14 | assumption. 15 | Qed. 16 | 17 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_cycle.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.cycle. 2 | 3 | Goal True /\ False /\ 1=1. 4 | split;[|split]. 5 | all: eltac.cycle 1. 6 | admit. 7 | reflexivity. 8 | exact I. 9 | Abort. 10 | 11 | Goal True /\ False /\ 1=1. 12 | split;[|split]. 13 | all: eltac.cycle -1. 14 | reflexivity. 15 | exact I. 16 | admit. 17 | Abort. 18 | 19 | Goal True /\ False /\ 1=1. 20 | split;[|split]. 21 | Fail all: eltac.cycle 3. 22 | Abort. -------------------------------------------------------------------------------- /apps/eltac/tests/test_discriminate.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.discriminate. 2 | 3 | Set Implicit Arguments. 4 | 5 | Inductive foo (A : Type) | (B : Type) : nat -> Type := 6 | | K : foo B 0 7 | | K1 : forall n, foo B n -> foo B (S n) 8 | | K2 : forall n, (A -> foo (B*B) n) -> foo B (n+n). 9 | 10 | Elpi derive.isK foo. 11 | 12 | (* Let's test a little that we are not too syntactic *) 13 | Definition AliasK2 A B n (f : A -> foo A (B*B) n) := K2 f. 14 | Definition AliasEQ := @eq. 15 | 16 | Example test_discriminate (k : foo nat nat 0) (f : nat -> foo nat (nat*nat) 1) : 17 | AliasEQ (AliasK2 f) (K1 (K1 k)) -> K nat nat = K nat nat -> { Type = Prop } + { True = False }. 18 | Proof. 19 | intros H F. 20 | Fail eltac.discriminate (F). 21 | eltac.discriminate (H). 22 | Qed. 23 | 24 | 25 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_fail.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.fail. 2 | 3 | Goal False. 4 | try (eltac.fail 0). 5 | Fail try (eltac.fail 1). 6 | Abort. 7 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_generalize.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.generalize. 2 | 3 | Example test_generalize x y (H : x = y) (H1 : 0 <= x) (d := x + 1) (H2 : y = 1) : x + d + y = 2. 4 | Proof. 5 | eltac.generalize (x). 6 | intros x0 T0 T1. 7 | Abort. 8 | 9 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_intro.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.intro. 2 | 3 | Lemma test1 : forall x, x = 1. 4 | Proof. 5 | eltac.intro "a". 6 | Abort. 7 | 8 | Example test_intro : True -> True. 9 | Proof. 10 | eltac.intro x. 11 | exact x. 12 | Qed. 13 | 14 | -------------------------------------------------------------------------------- /apps/eltac/tests/test_rewrite.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import eltac.rewrite. 2 | 3 | Axiom add_comm : forall x y, x + y = y + x. 4 | Axiom mul_comm : forall x y, x * y = y * x. 5 | 6 | Goal (forall x : nat, 1 + x = x + 1) -> 7 | forall y, 2 * ((y+y) + 1) = ((y + y)+1) * 2. 8 | Proof. 9 | intro H. 10 | intro x. 11 | eltac.rewrite H. 12 | eltac.rewrite mul_comm. 13 | exact eq_refl. 14 | Defined. 15 | 16 | Section Example_rewrite. 17 | Variable A : Type. 18 | Variable B : A -> Type. 19 | Variable C : forall (a : A) (b : B a), Type. 20 | Variable add : forall {a : A} {b : B a}, C a b -> C a b -> C a b. 21 | Variable sym : forall {a : A} {b : B a} (c c' : C a b), add c c' = add c' c. 22 | 23 | Goal forall (a : A) (b : B a) (x y : C a b), 24 | add x y = add y x /\ add x y = add y x. 25 | Proof. 26 | intros a b x y. 27 | eltac.rewrite @sym. (* @sym is a gref *) 28 | (** [add y x = add y x /\ add y x = add y x] *) 29 | easy. 30 | Defined. 31 | 32 | Goal forall (a : A) (b : B a) (x y : C a b), 33 | add x y = add y x /\ add x y = add y x. 34 | Proof. 35 | intros a b x y. 36 | eltac.rewrite sym. (* because of implicit arguments, this is sym _ _, which is a term *) 37 | easy. 38 | Defined. 39 | 40 | Goal forall n, 2 * n = n * 2. 41 | Proof. 42 | intro n. 43 | Fail eltac.rewrite add_comm. 44 | eltac.rewrite add_comm "strong". 45 | Abort. 46 | 47 | End Example_rewrite. 48 | -------------------------------------------------------------------------------- /apps/eltac/theories/apply.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic apply. 4 | Elpi Accumulate lp:{{ 5 | pred apply i:term, i:term, o:goal, o:list sealed-goal. 6 | 7 | apply T _ G GL :- refine T G GL, !. 8 | 9 | apply Term Ty G GL :- 10 | whd Ty [] (prod _ _ B) [], 11 | apply {coq.mk-app Term [Hole]} (B Hole) G GL. 12 | 13 | apply _ _ _ _ :- coq.ltac.fail _ "Couldn't unify type of term with goal". 14 | 15 | solve (goal Ctx _ _ _ [trm T] as G) GL :- 16 | std.assert-ok! (coq.typecheck T Ty) "Illtyped argument", 17 | 18 | apply T Ty G GL. 19 | }}. 20 | 21 | Tactic Notation "eltac.apply" constr(T) := elpi apply ltac_term:(T). -------------------------------------------------------------------------------- /apps/eltac/theories/assumption.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic assumption. 4 | Elpi Accumulate lp:{{ 5 | 6 | solve (goal Ctx Ev _ _ _) [] :- 7 | std.exists Ctx (x\ x = decl Ev _ _ ; x = def Ev _ _ _). 8 | 9 | solve _ _ :- coq.ltac.fail _ "No assumption unifies with the goal". 10 | 11 | }}. 12 | 13 | 14 | 15 | Tactic Notation "eltac.assumption" := elpi assumption. 16 | -------------------------------------------------------------------------------- /apps/eltac/theories/case.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic case. 4 | Elpi Accumulate lp:{{ 5 | 6 | pred mk-abstracted-goal i:list term, i:term, i:term, i:list term, i:list term, o:term. 7 | mk-abstracted-goal ToAbstract Goal _IndSort Vars _VarsTys Out :- 8 | std.map2 ToAbstract Vars (t\v\r\ r = copy t v) Subst, 9 | % Non deterministically we abstract until we obtain a well typed term 10 | (Subst ==> copy Goal Out), 11 | coq.say "trying" {coq.term->string Out}, 12 | coq.typecheck Out _ ok. 13 | 14 | pred mk-empty-branches i:term, i:term, i:list term, i:list term, o:term. 15 | mk-empty-branches _K _KTy _Vars _VarsTys HOLE_. 16 | 17 | solve (goal _ _ GTy _ [trm T] as G) NG :- !, std.do! [ 18 | std.assert-ok! (coq.typecheck T Ty) "input term illtyped", 19 | std.assert! (coq.safe-dest-app Ty (global (indt I)) Args) "the type is not inductive", 20 | coq.env.indt I _ ParamsNo _ _ _ _, 21 | std.drop ParamsNo Args Idxs, 22 | std.append Idxs [T] ToAbstract, 23 | coq.build-match T Ty (mk-abstracted-goal ToAbstract GTy) mk-empty-branches M, 24 | refine M G NG 25 | ]. 26 | 27 | solve _ _ :- usage. 28 | 29 | usage :- coq.error "Usage: eltac.case ". 30 | 31 | 32 | }}. 33 | 34 | 35 | 36 | Tactic Notation "eltac.case" constr(T) := elpi case ltac_term:(T). 37 | -------------------------------------------------------------------------------- /apps/eltac/theories/clear.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic clear. 4 | Elpi Accumulate lp:{{ 5 | pred not-hyp i:term, i:prop, o:term. 6 | not-hyp X (decl Y _ Ty) Y :- not (occurs X Ty), not (X = Y). 7 | not-hyp X (def Y _ Ty Bo) Y :- not (occurs X Ty ; occurs X Bo), not (X = Y). 8 | 9 | solve (goal Ctx R T E [trm X]) [seal (goal Ctx R T E [])] :- name X, !, std.do! [ 10 | std.map-filter Ctx (not-hyp X) VisibleRev, 11 | prune E1 {std.rev VisibleRev}, % preserve the order 12 | std.assert-ok! (coq.typecheck E1 T) "cannot clear", 13 | E = E1 14 | ]. 15 | solve (goal _ _ _ _ Args) _ :- coq.error "clear expects 1 name, you passed:" Args. 16 | }}. 17 | 18 | Tactic Notation "eltac.clear" hyp(V) := elpi clear ltac_term:(V). 19 | 20 | Elpi Tactic clearbody. 21 | Elpi Accumulate lp:{{ 22 | pred drop-body i:list argument, i:prop, o:prop. 23 | drop-body ToBeCleared (def V Name Ty _Bo) (decl V Name Ty) :- std.mem ToBeCleared (trm V), !. 24 | drop-body _ (decl _ _ _ as X) X. 25 | drop-body _ (def _ _ _ _ as X) X. 26 | 27 | msolve [nabla G] [nabla G1] :- pi x\ msolve [G x] [G1 x]. 28 | msolve [seal (goal Ctx _ T E ToBeCleared)] [seal (goal Ctx1 _ T E1 [])] :- 29 | std.map Ctx (drop-body ToBeCleared) Ctx1, 30 | (@ltacfail! 0 ==> % this failure can be catch by ltac 31 | Ctx1 ==> % in the new context, do... 32 | std.assert-ok! (coq.typecheck-ty T _) "cannot clear since the goal does not typecheck in the new context"), 33 | (Ctx1 ==> std.assert-ok! (coq.typecheck E1 T) "should not happen"), % E1 see all the proof variables (the pi x in the nabla case) and T is OK in Ctx1 34 | E = {{ lp:E1 : lp:T }}. % we make progress by saying that the old goal/evar is solved by the new one (which has the same type thanks to the line above) 35 | % note that E = E1 would be "unstable" since elpi could decide to 36 | % actually do E1 := E, while E = (let `x` T E1 x\x) forces elpi 37 | % to go the other way around 38 | }}. 39 | 40 | Tactic Notation "eltac.clearbody" hyp_list(V) := elpi clearbody ltac_term_list:(V). 41 | -------------------------------------------------------------------------------- /apps/eltac/theories/constructor.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic constructor. 4 | Elpi Accumulate lp:{{ 5 | 6 | solve (goal _ _ Ty _ _ as G) GS :- std.do! [ 7 | @ltacfail! _ => 8 | std.assert! (whd Ty [] (global (indt GR)) _) "The goal is not an inductive type", 9 | coq.env.indt GR _ _ _ _ Ks Kt, 10 | std.exists2 Ks Kt (k\ t\ sigma P\ 11 | coq.saturate t (global (indc k)) P, 12 | refine P G GS) 13 | ]. 14 | 15 | solve _ _ :- coq.error "eltac.constructor: this should never happen". 16 | 17 | }}. 18 | 19 | 20 | 21 | Tactic Notation "eltac.constructor" := elpi constructor. 22 | -------------------------------------------------------------------------------- /apps/eltac/theories/cycle.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic cycle. 4 | Elpi Accumulate lp:{{ 5 | 6 | pred read-arg i:sealed-goal, o:list argument. 7 | read-arg (nabla G) X :- pi x\ read-arg (G x) X. 8 | read-arg (seal (goal _ _ _ _ A)) A. 9 | 10 | pred cycle i:int, i:list sealed-goal, o:list sealed-goal. 11 | cycle N L PL :- N > 0, 12 | std.length L M, 13 | std.assert! (N < M) "not enough goals", 14 | std.split-at N L B A, 15 | std.append A B PL. 16 | cycle N L PL :- N < 0, 17 | std.length L M, 18 | N' is M + N, 19 | cycle N' L PL. 20 | 21 | msolve GL GS :- 22 | GL = [G|_], 23 | read-arg G [int N], 24 | if (N = 0) (GS = GL) (cycle N GL GS). 25 | 26 | }}. 27 | 28 | 29 | 30 | Tactic Notation "eltac.cycle" int(n) := elpi cycle ltac_int:(n). 31 | -------------------------------------------------------------------------------- /apps/eltac/theories/discriminate.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.derive.elpi Extra Dependency "discriminate.elpi" as discriminate. 2 | 3 | From elpi.apps Require Export derive.isK derive.bcongr derive.eqK. 4 | 5 | (** A tactic proving the current goal out of a false equation *) 6 | 7 | Elpi Tactic discriminate. 8 | Elpi Accumulate Db derive.isK.db. 9 | Elpi Accumulate File discriminate. 10 | Elpi Accumulate lp:{{ 11 | solve (goal _ Ev Ty _ [trm E] ) [] :- !, 12 | of E Eq ER, !, ltac.discriminate ER Eq Ty Ev. 13 | 14 | solve _ _ :- usage. 15 | 16 | usage :- coq.error "Usage: eltac.discriminate ". 17 | }}. 18 | 19 | 20 | Tactic Notation "eltac.discriminate" constr(T) := elpi discriminate ltac_term:(T). 21 | -------------------------------------------------------------------------------- /apps/eltac/theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.eltac) 3 | (package rocq-elpi) 4 | (theories elpi elpi.apps.derive)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/eltac/theories/fail.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic fail. 4 | Elpi Accumulate lp:{{ 5 | solve (goal _ _ _ _ [int N]) _ :- coq.ltac.fail N. 6 | solve (goal _ _ _ _ Args) _ :- coq.error "eltac.fail expects 1 integer, you passed:" Args. 7 | 8 | }}. 9 | 10 | 11 | Tactic Notation "eltac.fail" int(n) := elpi fail ltac_int:(n). 12 | -------------------------------------------------------------------------------- /apps/eltac/theories/generalize.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic generalize. 4 | Elpi Accumulate lp:{{ 5 | pred occurs-hyp i:term, i:prop, o:term. 6 | occurs-hyp X (decl Y _ Ty) Y :- occurs X Ty. 7 | occurs-hyp X (def Y _ Ty Bo) Y :- occurs X Ty ; occurs X Bo. 8 | 9 | solve (goal Ctx _ _ _ [trm X] as G) GS :- name X, !, std.do! [ 10 | std.map-filter Ctx (occurs-hyp X) Generalize, 11 | refine (app[NEW_,X|Generalize]) G GS, 12 | ]. 13 | solve (goal _ _ _ _ Args) _ :- coq.error "eltac.generalize expects 1 name, you passed:" Args. 14 | }}. 15 | 16 | Tactic Notation "eltac.generalize" constr(V) := elpi generalize ltac_term:(V). 17 | -------------------------------------------------------------------------------- /apps/eltac/theories/injection.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.derive.elpi Extra Dependency "injection.elpi" as injection. 2 | 3 | From elpi.apps Require Export derive.projK derive.bcongr. 4 | 5 | (** A tactic pushing an equation under a constructor *) 6 | 7 | Elpi Tactic injection. 8 | Elpi Accumulate Db derive.projK.db. 9 | Elpi Accumulate File injection. 10 | Elpi Accumulate lp:{{ 11 | solve (goal _ _ _ _ [trm E] as G) NG :- !, 12 | of E Eq ER, !, ltac.injection ER Eq _ P, 13 | if (P = []) (coq.error "Could not generate new equations") 14 | (refine (app[New_|P]) G NG). 15 | 16 | solve _ _ :- usage. 17 | 18 | usage :- coq.error "Usage: eltac.injection ". 19 | }}. 20 | 21 | 22 | Tactic Notation "eltac.injection" constr(T) := elpi injection ltac_term:(T). 23 | -------------------------------------------------------------------------------- /apps/eltac/theories/intro.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic intro. 4 | Elpi Accumulate lp:{{ 5 | 6 | solve (goal _ _ _ _ [str ID] as G) GS :- !, 7 | std.assert! (coq.ltac.id-free? ID G) "name already taken", 8 | coq.id->name ID N, 9 | refine (fun N _ _) G GS. 10 | 11 | solve _ _ :- usage. 12 | 13 | usage :- coq.error "Usage: eltac.intro". 14 | 15 | }}. 16 | 17 | 18 | 19 | Tactic Notation "eltac.intro" string(ID) := elpi intro ltac_string:(ID). 20 | Tactic Notation "eltac.intro" ident(ID) := elpi intro ltac_string:(ID). 21 | -------------------------------------------------------------------------------- /apps/eltac/theories/rewrite.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic rewrite. 4 | Elpi Accumulate lp:{{ 5 | % Second argument is a type of the form forall x1 x2 x3... P = Q. 6 | % First argument is a term of that type. 7 | % This tactic finds a subterm of the goal that Q unifies with 8 | % and rewrites all instances of that subterm from right to left. 9 | pred rewrite i:list argument, i:term, i:term, o:goal, o:list sealed-goal. 10 | 11 | % The copy predicate used below is discussed in the tutorial here: 12 | % https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_tactic.html#let-s-code-set-in-elpi 13 | 14 | rewrite Strong Eqpf {{@eq lp:S lp:P lp:Q }} (goal _ _ GoalType _ _ as G) GL :- 15 | % First, introduce a rule that causes "copy" to act as a function 16 | % sending a type T to the same type, but with all 17 | % subterms of T unifiable with Q to be replaced with a fresh constant x. 18 | pi x\ 19 | (pi J\ copy J x :- Strong = [str "strong"| _], coq.unify-leq Q J ok) => 20 | (pi J\ copy J x :- [] = Strong, Q = J) => 21 | % Apply this copy function to the goal type. 22 | (copy GoalType (A x), 23 | % If the subterm Q did indeed appear in the goal, 24 | % then pattern match on the given equality assumption P = Q, 25 | % causing Q to be replaced with P everywhere. 26 | if (occurs x (A x)) 27 | (refine (match 28 | Eqpf {{ fun a (e : @eq lp:S lp:P a) => lp:(A a) }} 29 | % We only want to create one hole, 30 | % the one corresponding to the 31 | % contents of the (single) branch of the match. 32 | [Hole_]) 33 | G GL 34 | ) 35 | (coq.ltac.fail _ "Couldn't unify")). 36 | 37 | solve (goal _ _ _ _ [trm Eq | Strong] as G) GL :- 38 | coq.typecheck Eq Ty ok, 39 | coq.saturate Ty Eq Eq', 40 | coq.typecheck Eq' Ty' ok, 41 | rewrite Strong Eq' Ty' G GL. 42 | }}. 43 | 44 | Tactic Notation "eltac.rewrite" ident(T) := elpi rewrite ltac_term:(T). 45 | Tactic Notation "eltac.rewrite" uconstr(T) := elpi rewrite ltac_term:(T). 46 | Tactic Notation "eltac.rewrite" uconstr(T) string(s) := elpi rewrite ltac_term:(T) ltac_string:(s). -------------------------------------------------------------------------------- /apps/eltac/theories/tactics.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.eltac Require Export 2 | apply 3 | intro 4 | rewrite 5 | constructor 6 | assumption 7 | discriminate 8 | injection 9 | case 10 | generalize 11 | fail 12 | clear 13 | cycle 14 | . -------------------------------------------------------------------------------- /apps/locker/README.md: -------------------------------------------------------------------------------- 1 | # Locker 2 | 3 | The `lock` and `mlock` commands let you lock definitions. 4 | 5 | ## Example of `lock` 6 | 7 | ```coq 8 | lock Definition x := 3. 9 | ``` 10 | 11 | is elaborated to 12 | 13 | ```coq 14 | Lemma x_key_subproof : unit. Proof. exact: tt. Qed. 15 | Definition x := locked_with x_key_subproof 3. 16 | Canonical x_unlock_subterm := Unlockable ... 17 | ``` 18 | 19 | Here `locked_with` comes from `ssreflect.v` and protects the body of `x` 20 | under a match on `x_key_subproof` which is `Qed` opaque. 21 | Hence `x` is provably equal to 3, but not computationally equal to it. 22 | 23 | Given the canonical structure registration, `rewrite unlock` will replace `x` 24 | by `3`. 25 | 26 | ## Example of `mlock` 27 | 28 | ```coq 29 | mlock Definition x := 3. 30 | ``` 31 | 32 | is elaborated to 33 | 34 | ```coq 35 | Module Type x_Locked. 36 | Axiom body : nat. 37 | Axiom unlock : body = 3. 38 | End x_Locked. 39 | Module x : x_Locked. ... End x. 40 | Notation x := x.body. 41 | Canonical x_unlock_subterm := Unlockable x.unlock. 42 | ``` 43 | 44 | Hence `x` (actually `x.body`) is a new symbol and `x.unlock` is its 45 | defining equation. 46 | 47 | Given the canonical structure registration, `rewrite unlock` will replace `x` 48 | by `3`. 49 | 50 | ## Limitations 51 | 52 | `mlock` uses a module based locking. The body is really sealed but this 53 | command cannot be used inside sections (since modules cannot be declared 54 | inside sections). 55 | 56 | `lock` uses opaque key based locking. It can be used everywhere, even inside 57 | sections, but conversion (term comparison) may cross the lock (by congruence) 58 | and hence compare possibly large terms. 59 | 60 | See also the section about locking in [ssereflect.v](https://github.com/coq/coq/blob/master/theories/ssr/ssreflect.v). 61 | -------------------------------------------------------------------------------- /apps/locker/elpi/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.locker.elpi) 3 | (package rocq-elpi) 4 | (theories elpi)) 5 | 6 | (rule 7 | (target dummy.v) 8 | (deps 9 | (glob_files *.elpi)) 10 | (action 11 | (with-stdout-to %{target} 12 | (progn 13 | (run rocq_elpi_shafile %{deps}))))) 14 | 15 | (install 16 | (files 17 | (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/locker/elpi/))) 18 | (section lib_root) 19 | (package rocq-elpi)) 20 | -------------------------------------------------------------------------------- /apps/locker/tests/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.locker.tests) 3 | (package rocq-elpi-tests) 4 | (theories elpi elpi.apps.locker)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/locker/theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.locker) 3 | (package rocq-elpi) 4 | (theories elpi elpi.apps.locker.elpi)) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /apps/tc/elpi/WIP/deactivate_evar.elpi: -------------------------------------------------------------------------------- 1 | /* 2 | when solving a goal in tc, we want to trigger the declared evar only after 3 | the proof search. This means that, while the search is performed, we do not 4 | risk to assign too early incorrect types (for example with wrong universes). 5 | The evar typechecking is triggered after the search, just before refining the 6 | proof with the original goal. 7 | We use the guard declare-evars-now that to trigger the constraints to reproduce 8 | this behavior. 9 | */ 10 | % pred declare-evar-later i:list prop, i:term, i:term, i:term. 11 | % pred declare-evars-now. 12 | 13 | % constraint declare-evar-later declare-evars-now { 14 | % rule declare-evars-now \ (declare-evar-later Ctx RawEv Ty Ev) <=> (declare-evars-now, Ctx => evar RawEv Ty Ev). 15 | % rule \ declare-evars-now. 16 | % } 17 | 18 | % declare-evars-now :- 19 | % declare_constraint declare-evars-now [_]. 20 | 21 | % We want to deactivate the evar declaration if coming from the 22 | % original goal (the original type class problem to be solved) 23 | % :before "default-declare-evar" 24 | % :name "tc-solver-declare-evar" 25 | % declare-evar Ctx X Ty E :- !, 26 | % declare_constraint (declare-evar-later Ctx X Ty E) [_]. 27 | 28 | -------------------------------------------------------------------------------- /apps/tc/elpi/WIP/modes.elpi: -------------------------------------------------------------------------------- 1 | /* license: GNU Lesser General Public License Version 2.1 or later */ 2 | /* ------------------------------------------------------------------------- */ 3 | 4 | % pred make-modes-cl i:gref, i:list term, i:term, i:list (list hint-mode), i:list (list term), o:prop. 5 | % make-modes-cl T V (prod _ _ X) HintModes L (pi x\ C x):- 6 | % std.map HintModes (x\r\ [r|_] = x) FST, 7 | % std.map HintModes (x\r\ [_|r] = x) LAST, 8 | % pi x\ sigma NewL\ 9 | % std.map2 L FST (l\m\r\ if (m = mode-input) (r = [x | l]) (r = l)) NewL, 10 | % make-modes-cl T [x | V] (X x) LAST NewL (C x). 11 | % make-modes-cl T V _ _ L Clause :- 12 | % Ty = {coq.mk-app (global T) {std.rev V}}, 13 | % Clause = (pi s\ tc T Ty s :- std.forall L (x\ std.exists x var), !, coq.error "Invalid mode for" Ty). 14 | 15 | % takes the type of a class and build a list 16 | % of hint mode where the last element is mandatory 17 | pred make-last-hint-mode-input i:term, o:list hint-mode. 18 | make-last-hint-mode-input (prod _ _ (x\ (prod _ _ _) as T)) [mode-output | L] :- 19 | pi x\ make-last-hint-mode-input (T x) L. 20 | make-last-hint-mode-input (prod _ _ _) [mode-input]. 21 | make-last-hint-mode-input (sort _) []. 22 | 23 | % build a list of the seme langht as the the passed one 24 | % where all the elements are [] 25 | pred build-empty-list i:list B, o:list (list A). 26 | build-empty-list [] []. 27 | build-empty-list [_ | TL] [[] | L] :- 28 | build-empty-list TL L. 29 | 30 | % add the hint modes of a Class to the database. 31 | % note that if the Class has not specified hint mode 32 | % then we assume the hint mode to be - - - ... ! 33 | pred add-modes i:gref. 34 | :if "add-modes" 35 | add-modes GR :- 36 | % the hint mode is added only if not exists 37 | if (not (tc.class GR _ _)) ( 38 | coq.env.typeof GR Ty, 39 | coq.hints.modes GR "typeclass_instances" ModesProv, 40 | if (ModesProv = []) (Modes = [{make-last-hint-mode-input Ty}]) (Modes = ModesProv), 41 | % make-modes-cl GR [] Ty Modes {build-empty-list Modes} Cl, 42 | % add-tc-db _ (after "firstHook") Cl, 43 | ) true. 44 | add-modes _. -------------------------------------------------------------------------------- /apps/tc/elpi/alias.elpi: -------------------------------------------------------------------------------- 1 | /* license: GNU Lesser General Public License Version 2.1 or later */ 2 | /* ------------------------------------------------------------------------- */ 3 | 4 | namespace tc { 5 | pred alias i:term, o:term. 6 | 7 | pred replace-with-alias.aux i:list term, o:list term, o:bool. 8 | replace-with-alias.aux [] [] ff. 9 | replace-with-alias.aux [X | Xs] [Y | Ys] B :- 10 | replace-with-alias X Y B', 11 | replace-with-alias.aux Xs Ys B'', 12 | or B' B'' B. 13 | 14 | % [replace-with-alias T T1 Changed] T1 is T where aliases are replaced 15 | pred replace-with-alias i:term, o:term, o:bool. 16 | replace-with-alias A Sol tt :- alias A Sol', 17 | replace-with-alias Sol' Sol _. 18 | replace-with-alias (app ToReplace) (app Sol) A :- 19 | replace-with-alias.aux ToReplace Sol A. 20 | replace-with-alias A A ff. 21 | } -------------------------------------------------------------------------------- /apps/tc/elpi/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.tc.elpi) 3 | (package rocq-elpi) 4 | (theories elpi)) 5 | 6 | (rule 7 | (target dummy.v) 8 | (deps 9 | (glob_files *.elpi)) 10 | (action 11 | (with-stdout-to %{target} 12 | (progn 13 | (run rocq_elpi_shafile %{deps}))))) 14 | 15 | (install 16 | (files 17 | (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/tc/elpi/))) 18 | (section lib_root) 19 | (package rocq-elpi)) 20 | -------------------------------------------------------------------------------- /apps/tc/elpi/parser_addInstances.elpi: -------------------------------------------------------------------------------- 1 | /* license: GNU Lesser General Public License Version 2.1 or later */ 2 | /* ------------------------------------------------------------------------- */ 3 | 4 | namespace tc { 5 | kind enum type. 6 | type path string -> string -> enum. 7 | type addInstPrio int -> string -> enum. 8 | type tcOrInst list string -> enum. 9 | type ignoreInstances, ignoreClasses string -> list string -> enum. 10 | 11 | pred parse i:list argument, o:enum. 12 | parse [str ClassName, str "path", str Path] (path ClassName Path). 13 | parse [str ClassName, str "ignoreInstances" | InstNames] (ignoreInstances ClassName Res) :- 14 | args->str-list InstNames Res. 15 | parse [str ClassName, str "ignoreClasses" | ClassNames] (ignoreClasses ClassName Res) :- 16 | args->str-list ClassNames Res. 17 | parse ClassNames (tcOrInst Res) :- args->str-list ClassNames Res. 18 | parse [int N, str Instance] (addInstPrio N Instance). 19 | 20 | pred run-command i:enum. 21 | :if "debug" 22 | run-command A :- coq.say A, fail. 23 | run-command (ignoreClasses ClassName IgnoreClasses) :- 24 | coq.locate ClassName ClassGR, 25 | tc.add-tc-or-inst-gr IgnoreClasses [] [ClassGR]. 26 | run-command (tcOrInst InstNames) :- 27 | std.map InstNames coq.locate InstGR, 28 | tc.add-tc-or-inst-gr [] [] InstGR. 29 | run-command (path ClassName Path):- 30 | tc.add-path ClassName Path. 31 | run-command (ignoreInstances ClassName InstNames):- 32 | coq.locate ClassName ClassGR, 33 | tc.add-tc-or-inst-gr [] InstNames [ClassGR]. 34 | run-command (addInstPrio Prio InstanceName) :- 35 | coq.locate InstanceName InstGr, 36 | tc.compile.instance-gr InstGr C, 37 | S is int_to_string Prio, 38 | tc.add-tc-db _ (before S) C. 39 | } -------------------------------------------------------------------------------- /apps/tc/elpi/tc_same_order.elpi: -------------------------------------------------------------------------------- 1 | % [Typeclass, Coq Instances, Elpi Instances] 2 | % the instances of the given typeclass should be in the same order as Coq 3 | pred correct_instance_order_aux i:gref, i:(list tc-instance), i:(list gref). 4 | :name "tc-correct-instance-order-aux" 5 | correct_instance_order_aux _ [] []. 6 | correct_instance_order_aux TC [tc-instance I1 _ | TL1] [I1 | TL2] :- 7 | correct_instance_order_aux TC TL1 TL2. 8 | 9 | % [Typeclasses of Coq, Elpi Instances] 10 | pred correct_instance_order i:(list gref), i:(list prop). 11 | :name "tc-correct-instance-order" 12 | correct_instance_order [] _. 13 | correct_instance_order [TC | TL] ElpiInst :- 14 | coq.TC.db-for TC CoqInst, 15 | std.map-filter ElpiInst (x\r\ sigma I\ x = tc.instance _ I TC _, r = I) ElpiInstTC, 16 | if (correct_instance_order_aux TC CoqInst ElpiInstTC) 17 | (correct_instance_order TL ElpiInst) 18 | (coq.error "Error in import order\n" 19 | "Expected :" CoqInst "\nFound :" ElpiInstTC). 20 | 21 | :name "tc-same-order-main" 22 | main _ :- 23 | std.findall (tc.instance _ _ _ _) ElpiInst, 24 | correct_instance_order {coq.TC.db-tc} ElpiInst. -------------------------------------------------------------------------------- /apps/tc/examples/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.tc.examples) 3 | (theories elpi elpi.apps.tc elpi_stdlib)) 4 | 5 | (include_subdirs qualified) 6 | -------------------------------------------------------------------------------- /apps/tc/src/dune.in: -------------------------------------------------------------------------------- 1 | (library 2 | (name elpi_tc_plugin) 3 | (public_name rocq-elpi.tc) 4 | (flags :standard -w -27) 5 | (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) 6 | (libraries @@ROCQ_RUNTIME@@.plugins.ltac @@ROCQ_RUNTIME@@.vernac rocq-elpi.elpi)) 7 | 8 | (coq.pp 9 | (modules rocq_elpi_tc_hook)) 10 | -------------------------------------------------------------------------------- /apps/tc/src/elpi_tc_plugin.mlpack: -------------------------------------------------------------------------------- 1 | Rocq_elpi_tc_time 2 | Rocq_elpi_tc_register 3 | Rocq_elpi_class_tactics_takeover 4 | Rocq_elpi_tc_hook 5 | -------------------------------------------------------------------------------- /apps/tc/src/rocq_elpi_class_tactics_takeover.mli: -------------------------------------------------------------------------------- 1 | (* rocq-elpi: Coq terms as the object language of elpi *) 2 | (* license: GNU Lesser General Public License Version 2.1 or later *) 3 | (* ------------------------------------------------------------------------- *) 4 | 5 | type aaction = ARm | AAdd | ASet | ANone | AAll 6 | 7 | val set_solver_mode : aaction -> string list -> Libnames.qualid list -> unit 8 | val solver_register : Elpi_plugin.Rocq_elpi_utils.qualified_name -> unit 9 | val solver_activate : Elpi_plugin.Rocq_elpi_utils.qualified_name -> unit 10 | val solver_deactivate : Elpi_plugin.Rocq_elpi_utils.qualified_name -> unit 11 | -------------------------------------------------------------------------------- /apps/tc/src/rocq_elpi_tc_time.ml: -------------------------------------------------------------------------------- 1 | open Elpi_plugin 2 | 3 | let time_tc_bench = ref false 4 | 5 | let set_time_tc_bench = (:=) time_tc_bench 6 | let get_time_tc_bench () = !time_tc_bench 7 | 8 | let () = Goptions.declare_bool_option { optstage = Summary.Stage.Interp; 9 | optdepr = None; 10 | optkey = ["Time";"TC";"Bench"]; 11 | optread = get_time_tc_bench; 12 | optwrite = set_time_tc_bench; } 13 | 14 | let time_all b = 15 | CDebug.set_flag Rocq_elpi_utils.elpitime_flag b; 16 | set_time_tc_bench b 17 | -------------------------------------------------------------------------------- /apps/tc/tests-stdlib/bench/bench_inj.v: -------------------------------------------------------------------------------- 1 | From elpi_apps_tc_tests_stdlib Require Import stdppInj. 2 | Elpi TC.Solver. Set TC Time Refine. Set TC Time Instance Search. Set Debug "elpitime". 3 | Goal Inj eq eq((compose f f )). Time apply _. Qed. 4 | -------------------------------------------------------------------------------- /apps/tc/tests-stdlib/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (package rocq-elpi-tests-stdlib) 3 | (name elpi_apps_tc_tests_stdlib) 4 | (flags :standard -async-proofs-cache force) 5 | (theories elpi elpi.apps.tc elpi.apps.tc.tests elpi_stdlib)) 6 | 7 | (include_subdirs qualified) 8 | -------------------------------------------------------------------------------- /apps/tc/tests-stdlib/eqSimplDef.v: -------------------------------------------------------------------------------- 1 | Require Import Bool Arith List. 2 | 3 | Class Eqb A : Type := eqb : A -> A -> bool. 4 | Global Hint Mode Eqb + : typeclass_instances. 5 | 6 | Notation " x == y " := (eqb x y) (no associativity, at level 70). 7 | 8 | Global Instance eqU : Eqb unit := { eqb x y := true }. 9 | Global Instance eqB : Eqb bool := { eqb x y := if x then y else negb y }. 10 | Global Instance eqP {A B} `{Eqb A} `{Eqb B} : Eqb (A * B) := { 11 | eqb x y := (fst x == fst y) && (snd x == snd y) }. -------------------------------------------------------------------------------- /apps/tc/tests-stdlib/test_commands_API.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | From elpi_apps_tc_tests_stdlib Require Import eqSimplDef. 3 | 4 | Elpi Command len_test. 5 | Elpi Accumulate Db tc.db. 6 | Elpi Accumulate lp:{{ 7 | pred counti i:gref, i:int. 8 | counti GR Len :- 9 | if (const _ = GR) 10 | (std.findall (tc.instance _ _ GR _) Cl, 11 | std.assert! ({std.length Cl} = Len) 12 | "Unexpected number of instances") 13 | true. 14 | 15 | main [str E, int Len] :- 16 | coq.locate E GR, 17 | counti GR Len. 18 | }}. 19 | 20 | 21 | TC.AddClasses Eqb. 22 | 23 | Module test1. 24 | TC.AddInstances Eqb ignoreInstances eqP. 25 | Elpi len_test Eqb 2. 26 | End test1. 27 | Reset test1. 28 | 29 | Module test2. 30 | Elpi len_test Eqb 0. 31 | End test2. 32 | Reset test2. 33 | 34 | Module test3. 35 | TC.AddInstances Eqb. 36 | Elpi len_test Eqb 3. 37 | End test3. 38 | Reset test3. 39 | 40 | 41 | (* About RewriteRelation. 42 | 43 | About RelationClasses.RewriteRelation. 44 | 45 | 46 | Elpi Query TC.Solver lp:{{ 47 | coq.gref->id {{:gref RelationClasses.RewriteRelation}} L. 48 | }}. *) 49 | 50 | Module test4. 51 | TC.AddAllClasses. 52 | TC.AddAllInstances eqU. 53 | 54 | Elpi Query TC.Solver lp:{{ 55 | EqP = {{:gref eqU}}, 56 | std.assert! (not (tc.instance _ EqP _ _)) "EqP should not be in the DB". 57 | }}. 58 | End test4. -------------------------------------------------------------------------------- /apps/tc/tests-stdlib/test_import/f1.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Export tc. 2 | From elpi.core Require Export Morphisms. 3 | 4 | Elpi TC Solver Override TC.Solver Rm Proper ProperProxy. 5 | -------------------------------------------------------------------------------- /apps/tc/tests-stdlib/test_import/f2.v: -------------------------------------------------------------------------------- 1 | From elpi_apps_tc_tests_stdlib.test_import Require Import f1. 2 | -------------------------------------------------------------------------------- /apps/tc/tests/WIP/add_alias.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | Elpi TC Solver Override TC.Solver All. 3 | Elpi Debug "use-alias". 4 | 5 | Class foo (A : Type) := f : Type. 6 | 7 | Global Instance fooNat : foo nat := {f := nat}. 8 | Global Instance fooBool : foo bool := {f := bool}. 9 | 10 | Elpi AddClasses foo. 11 | Elpi AddInstances foo. 12 | 13 | Definition nat' := nat. 14 | 15 | 16 | Goal foo nat. apply _. Qed. 17 | Goal foo bool. apply _. Qed. 18 | Goal foo nat'. Fail apply _. Abort. 19 | 20 | Module A. 21 | Elpi Accumulate TC.Solver lp:{{ 22 | alias {{nat'}} {{nat}}. 23 | }}. 24 | Goal foo nat'. apply _. Qed. 25 | End A. 26 | 27 | Definition nat'' := nat'. 28 | 29 | Elpi AddAlias (nat'') (nat'). 30 | Goal foo nat''. apply _. Qed. 31 | -------------------------------------------------------------------------------- /apps/tc/tests/WIP/cyclicTC_jarl.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | Elpi Debug "simple-compiler". 3 | Set TC NameShortPath. 4 | 5 | Elpi TC Solver Override TC.Solver All. 6 | 7 | Class A (T1 : Type). 8 | Class B (T1 : Type). 9 | 10 | Global Instance instA' (T1 : Type) (T2 : Type) : A bool. Qed. 11 | Global Instance instA (T1 : Type) `(B T1) : A T1. Qed. 12 | 13 | Global Instance instB (T1 : Type) `(A T1) : B T1. Qed. 14 | Global Instance instB' : B nat . Qed. 15 | 16 | Elpi Accumulate tc.db lp:{{ 17 | pred explored_gref o:gref. 18 | 19 | pred should_fail i:list gref, i:gref, i:gref. 20 | should_fail [] _ _. 21 | should_fail [Current | Tl] Current BlackElt :- !, 22 | if (std.mem Tl BlackElt) fail true. 23 | should_fail [_ | Tl] Current BlackElt :- !, 24 | should_fail Tl Current BlackElt. 25 | 26 | pred already_explored i:gref, i:gref. 27 | already_explored Current BlackElt :- 28 | std.findall (explored_gref _) As, 29 | std.map As (x\r\ x = explored_gref r) As', 30 | should_fail As' Current BlackElt. 31 | 32 | pred get_other i:gref, o:gref. 33 | 34 | pred under_extra i:gref, i:list prop, o:list prop. 35 | under_extra A B C :- std.map B (x\r\ (explored_gref A => x) = r) C1, 36 | C = [sigma x\ get_other A x, already_explored A x | C1]. 37 | 38 | :after "firstHook" 39 | tc.make-tc IsHead Ty Inst Hyp Clause :- !, 40 | app [global TC | TL] = Ty, 41 | tc.gref->pred-name TC TC_Str, 42 | std.append TL [Inst] Args, 43 | coq.elpi.predicate TC_Str Args Q, 44 | if (not IsHead) (Hyp = Hyp') (under_extra TC Hyp Hyp'), 45 | Clause = (Q :- Hyp'). 46 | }}. 47 | 48 | 49 | Elpi AddAllClasses. 50 | Elpi AddAllInstances. 51 | 52 | Elpi Command AddRecursivelyDependantTC. 53 | Elpi Accumulate Db tc.db. 54 | Elpi Accumulate lp:{{ 55 | main [trm (global A), trm (global B)] :- 56 | coq.elpi.accumulate _ "tc.db" 57 | (clause _ _ (get_other A B)), 58 | coq.elpi.accumulate _ "tc.db" 59 | (clause _ _ (get_other B A)). 60 | main L :- coq.say L. 61 | }}. 62 | 63 | 64 | Elpi AddRecursivelyDependantTC (A) (B). 65 | 66 | Elpi Bound Steps 10000. 67 | Check (_ : B bool). 68 | Check (_ : A nat). 69 | 70 | -------------------------------------------------------------------------------- /apps/tc/tests/WIP/included_proof.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Class EqDec (A : Type) := 4 | { eqb : A -> A -> bool ; 5 | eqb_leibniz : forall x y, eqb x y = true -> x = y }. 6 | 7 | Generalizable Variables A. 8 | 9 | Class Ord `(E : EqDec A) := { le : A -> A -> bool }. 10 | 11 | Class C (A : Set). 12 | 13 | Elpi TC Solver Override TC.Solver All. 14 | Global Instance cInst `{e: EqDec nat} : Ord e -> C nat. Admitted. 15 | 16 | (* 17 | We want to be sure that cInst when compiled has only one hypothesis: (Ord e). 18 | We don't want the hypothesis {e : EqDec nat} since it will be verified by (Ord e) 19 | *) 20 | (* TODO: it should not fail *) 21 | Fail Elpi Query TC.Solver lp:{{ 22 | compile {{:gref cInst}} _ _ CL, 23 | CL = (pi a\ pi b\ (_ :- (Hyp a b))), 24 | coq.say Hyp, 25 | pi a b\ 26 | expected-found (do _) (Hyp a b). 27 | }}. 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /apps/tc/tests/WIP/premisesSort/sort1.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.premisesSort Require Import sortCode. 2 | 3 | Set Warnings "+elpi". 4 | Class A (S : Type). 5 | Class B (S : Type). 6 | Class C (S : Type). 7 | 8 | Global Instance A1 : A nat. Admitted. 9 | Global Instance A2 : A bool. Admitted. 10 | 11 | Global Instance B1 : B nat. Admitted. 12 | 13 | Global Instance C1 {T : Type} `{A T, B T} : C bool. Admitted. 14 | 15 | (* Simpl example where we do backtrack *) 16 | Goal C bool. 17 | apply _. 18 | Qed. -------------------------------------------------------------------------------- /apps/tc/tests/WIP/premisesSort/sort2.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.premisesSort Require Import sortCode. 2 | Elpi Debug "simple-compiler". 3 | Set TC AddModes. 4 | 5 | Class A (S : Type). 6 | Class B (S : Type). 7 | Class C (S : Type). 8 | 9 | Global Hint Mode A + : typeclass_instances. 10 | 11 | Global Instance A1 : A nat. Admitted. 12 | 13 | Global Instance B1 : B nat. Admitted. 14 | 15 | (* 16 | Here since the output of T is input in A, we want to reorder 17 | the goals such that the proof of be is computed first. 18 | Question do we want to raise an error or try to rearrange 19 | subgoals in C1. We can try to make an analysis in the compiling 20 | phase to raise the error. 21 | *) 22 | Global Instance C1 {T : Type} `{e : A T, B T} : C bool. Admitted. 23 | 24 | Elpi AddAllClasses. 25 | Elpi AddAllInstances. 26 | 27 | Elpi TC Solver Override TC.Solver All. 28 | 29 | Elpi Print TC.Solver "elpi.apps.tc.tests/TC.Solver". 30 | Goal C bool. 31 | apply _. 32 | Qed. 33 | -------------------------------------------------------------------------------- /apps/tc/tests/WIP/premisesSort/sort3.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.premisesSort Require Import sortCode. 2 | Elpi Debug "simple-compiler". 3 | 4 | Class A (S : Type) (T : Type). 5 | Class B (S : Type) (T : Type). 6 | Class C (S : Type). 7 | 8 | Global Hint Mode A + - : typeclass_instances. 9 | Global Hint Mode B + - : typeclass_instances. 10 | Elpi AddAllClasses. 11 | 12 | Global Instance A1 : A nat nat. Admitted. 13 | Global Instance B1 : B nat nat. Admitted. 14 | 15 | Global Instance C1 {S T : Type} `{B S T, A T S} : C T. Admitted. 16 | 17 | Elpi AddAllInstances. 18 | Elpi TC Solver Override TC.Solver All. 19 | Goal C nat. 20 | apply _. 21 | Qed. 22 | 23 | (* Following has a cyclic dependecy, therefore error *) 24 | (* Global Instance C2 {S T : Type} `{A T S, B S T} : C bool. Admitted. *) 25 | (* Elpi AddInstances C2. *) 26 | 27 | (* Global Instance C3 {S T : Type} `{B T S} : C S. Admitted. *) 28 | (* Elpi AddInstances C3. *) -------------------------------------------------------------------------------- /apps/tc/tests/auto_compile.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Elpi TC Solver Override TC.Solver All. 4 | 5 | (* TODO: How to add the #[deterministic] pragma in front of the class? *) 6 | (* #[deterministic] Class A (T : Type) := {succ : T -> T}. *) 7 | Class A (T : Type) := {succ : T -> T}. 8 | #[local] Instance B : A nat := {succ n := S n}. 9 | Instance C : A bool := {succ b := negb b}. 10 | Instance Prod (X Y: Type) `(A X, A Y) : A (X * Y) := 11 | {succ b := match b with (a, b) => (succ a, succ b) end}. 12 | 13 | Elpi Accumulate TC.Solver lp:{{ 14 | :after "firstHook" 15 | solve _ _ :- coq.say "Solving in ELPI!", fail. 16 | }}. 17 | 18 | Goal A (nat * (nat * bool)). apply _. Qed. 19 | 20 | Module M. 21 | Class B (T : nat). 22 | Section A. 23 | Instance X : B 1. Qed. 24 | Goal B 1. apply _. Qed. 25 | 26 | Global Instance Y : B 2. Qed. 27 | Goal B 2. apply _. Qed. 28 | End A. 29 | Goal B 1. Proof. Fail apply _. Abort. 30 | Goal B 2. Proof. apply _. Qed. 31 | 32 | Section B. 33 | Variable V : nat. 34 | Global Instance Z : `(B 0) -> B V. Qed. 35 | Global Instance W : B 0. Qed. 36 | End B. 37 | 38 | Goal B 0. apply _. Qed. 39 | Goal B 10. apply _. Qed. 40 | End M. 41 | 42 | Goal M.B 1. apply M.X. Qed. 43 | Goal M.B 0. apply _. Qed. 44 | Goal M.B 10. apply _. Qed. 45 | 46 | Elpi Query TC.Solver lp:{{ 47 | % Small test for instance order 48 | sigma I L\ 49 | std.findall (tc.instance _ _ _ _) I, 50 | std.map-filter I (x\y\ x = tc.instance _ y {{:gref M.B}} _) 51 | [{{:gref M.W}}, {{:gref M.Y}}, {{:gref M.Z}}]. 52 | }}. 53 | 54 | Module S. 55 | Class Cl (i: nat). 56 | #[local] Instance Cl1 : Cl 1. Qed. 57 | #[global] Instance Cl2 : Cl 2. Qed. 58 | #[export] Instance Cl3 : Cl 3. Qed. 59 | End S. 60 | 61 | Elpi TC Solver Override TC.Solver None. 62 | Goal S.Cl 1 /\ S.Cl 2 /\ S.Cl 3. 63 | Proof. 64 | split. all:cycle 1. 65 | split. 66 | apply _. 67 | Fail apply _. 68 | Import S. 69 | apply _. 70 | Fail apply _. 71 | Abort. 72 | -------------------------------------------------------------------------------- /apps/tc/tests/contextDeepHierarchy.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | Unset Typeclass Resolution For Conversion. 3 | Set TC NameShortPath. 4 | Elpi TC Solver Override TC.Solver All. 5 | 6 | 7 | Class X (A: Type). 8 | Class Y (A: Type). 9 | Class Z (A: Type). 10 | 11 | Local Instance Inst1@{i} {A: Type@{i}} : X A -> Y A. Qed. 12 | Local Instance Inst2@{i} (A : Type@{i}): (forall A : Type@{i}, X A -> Y A) -> Z A. Qed. 13 | 14 | (* TODO: here Elpi Trace Fails... *) 15 | 16 | Goal forall A, Z A. 17 | intros. 18 | apply _. 19 | Qed. -------------------------------------------------------------------------------- /apps/tc/tests/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.tc.tests) 3 | (flags :standard -async-proofs-cache force) 4 | (package rocq-elpi-tests) 5 | (theories elpi elpi.apps.tc)) 6 | 7 | (include_subdirs qualified) 8 | (dirs :standard \ WIP) 9 | -------------------------------------------------------------------------------- /apps/tc/tests/hook_test.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | Elpi TC Solver Override TC.Solver All. 3 | 4 | Elpi TC.AddHook after 1000 1513. 5 | Elpi TC.AddHook before 1513 1512. 6 | 7 | Class A (n : nat). 8 | Instance Inst1 : A 3 | 1513. Qed. 9 | Instance Inst2 : A 100 | 1512. Qed. 10 | 11 | Elpi Query TC.Solver lp:{{ 12 | sigma InstL GrefL\ 13 | std.findall (tc.instance _ _ {{:gref A}} _) InstL, 14 | std.map InstL (x\r\ x = tc.instance _ r _ _) GrefL, 15 | GrefL = [{{:gref Inst2}}, {{:gref Inst1}}]. 16 | }}. 17 | 18 | 19 | -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f1.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Export sameOrderCommand. 2 | 3 | Class A (T : Set) := f : T -> T. 4 | 5 | Elpi SameOrderImport. -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f2a.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Export f1. 2 | From elpi.apps.tc.tests.importOrder Require Export sameOrderCommand. 3 | 4 | 5 | Global Instance f2aa : A nat := {f x := x}. 6 | Global Instance f2ab : A nat := {f x := x}. 7 | Global Instance f2ac : A nat := {f x := x}. 8 | Global Instance f2ad : A nat := {f x := x}. 9 | 10 | Elpi SameOrderImport. -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f2b.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Export f1. 2 | 3 | Global Instance f2ba : A nat := {f x := x}. 4 | Global Instance f2bb : A nat := {f x := x}. 5 | Global Instance f2bc : A nat := {f x := x}. 6 | Global Instance f2bd : A nat := {f x := x}. 7 | 8 | 9 | (* Elpi SameOrderImport. *) 10 | -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f3a.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Import f2a. 2 | From elpi.apps.tc.tests.importOrder Require Import f2b. 3 | 4 | Elpi SameOrderImport. 5 | -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f3b.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Import f2b. 2 | From elpi.apps.tc.tests.importOrder Require Import f2a. 3 | 4 | Elpi SameOrderImport. -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f3c.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Export f1. 2 | 3 | Global Instance f3a : A nat := {f x := x}. 4 | Global Instance f3b : A nat := {f x := x}. 5 | Global Instance f3c : A nat := {f x := x}. 6 | 7 | Elpi SameOrderImport. 8 | 9 | Section S1. Variable X : Type. 10 | Local Instance f3d : A nat := {f x := x}. 11 | Global Instance f3e : A nat := {f x := x}. 12 | Global Instance f3f : A nat := {f x := x}. 13 | 14 | Elpi SameOrderImport. 15 | End S1. 16 | 17 | 18 | Elpi SameOrderImport. 19 | 20 | Section S2. 21 | Context (T : Set). 22 | Global Instance f3g : A T := {f x := x}. 23 | 24 | Elpi SameOrderImport. 25 | End S2. 26 | 27 | Elpi SameOrderImport. 28 | 29 | Section S3. 30 | Context (T : Set). 31 | Global Instance f3g2 : A (T: Set) := {f x := x}. 32 | 33 | Global Instance f3h T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. 34 | 35 | Global Instance f3g3 : A (T: Set) := {f x := x}. 36 | Global Instance f3g4 : A (T: Set) | 10 := {f x := x}. 37 | 38 | Elpi SameOrderImport. 39 | End S3. 40 | 41 | Elpi SameOrderImport. -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f3d.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Export f1. 2 | From elpi.apps.tc.tests.importOrder Require Import f2b. 3 | Elpi SameOrderImport. 4 | 5 | Global Instance f3a' T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. 6 | 7 | 8 | Elpi SameOrderImport. 9 | Module M4'. 10 | (* From elpi.apps.tc.tests.importOrder Require Import f2a. *) 11 | Elpi SameOrderImport. 12 | 13 | Global Instance f3a : A nat := {f x := x}. 14 | 15 | 16 | Section S1. Variable X : Type. 17 | Global Instance f3b : A nat := {f x := x}. 18 | 19 | Section S1'. Variable Y : Type. 20 | Global Instance f3c : A nat := {f x := x}. 21 | 22 | End S1'. 23 | End S1. 24 | 25 | Elpi SameOrderImport. 26 | 27 | Section S2. Variable X : Type. 28 | Global Instance f3h T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. 29 | End S2. 30 | End M4'. 31 | 32 | Elpi SameOrderImport. 33 | -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f3e.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Export f1. 2 | From elpi.apps.tc.tests.importOrder Require Import f2b. 3 | From elpi.apps.tc.tests.importOrder Require Import f2a. 4 | 5 | Global Instance f3a' T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. 6 | 7 | Elpi SameOrderImport. 8 | Module M4'. 9 | Global Instance f3a : A nat := {f x := x}. 10 | 11 | Section S1. Variable X : Type. 12 | Global Instance f3b : A nat := {f x := x}. 13 | Section S1'. Variable Y : Type. 14 | Global Instance f3c : A nat := {f x := x}. 15 | End S1'. 16 | End S1. 17 | 18 | Section S2. Variable X : Type. 19 | Global Instance f3h T1 T2 `(A T1, A T2) : A (T1 * T2) | 100 := {f x := x}. 20 | End S2. 21 | End M4'. 22 | 23 | 24 | Elpi SameOrderImport. -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f3f.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Import f1. 2 | 3 | Section S1. 4 | Context (T : Set). 5 | Global Instance f3a : A T := {f x := x}. 6 | 7 | Elpi SameOrderImport. 8 | 9 | Section S2. 10 | Context (T1 : Set). 11 | Global Instance f3b : A T1 := {f x := x}. 12 | 13 | End S2. 14 | 15 | Elpi SameOrderImport. 16 | End S1. 17 | Elpi SameOrderImport. -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f3g.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Export f1. 2 | 3 | Module M8. 4 | Class Classe (A: Type) (B: Type). 5 | 6 | Global Instance I (a b c d: Type): Classe a a -> Classe b c. Admitted. 7 | 8 | Elpi SameOrderImport. 9 | End M8. 10 | -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/f4.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.importOrder Require Import f3f. 2 | From elpi.apps.tc.tests.importOrder Require Import f2a. 3 | From elpi.apps.tc.tests.importOrder Require Import f2b. 4 | From elpi.apps.tc.tests.importOrder Require Import f3c. 5 | From elpi.apps.tc.tests.importOrder Require Import f3d. 6 | From elpi.apps.tc.tests.importOrder Require Import f3g. 7 | 8 | Elpi SameOrderImport. -------------------------------------------------------------------------------- /apps/tc/tests/importOrder/sameOrderCommand.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Export tc. 2 | 3 | From elpi.apps.tc.elpi Extra Dependency "ho_link.elpi" as ho_link. 4 | From elpi.apps.tc.elpi Extra Dependency "tc_same_order.elpi" as tc_same_order. 5 | From elpi.apps.tc.elpi Extra Dependency "unif.elpi" as unif. 6 | 7 | Set Warnings "+elpi". 8 | Elpi Command SameOrderImport. 9 | Elpi Accumulate Db tc.db. 10 | Elpi Accumulate File unif. 11 | Elpi Accumulate File ho_link. 12 | Elpi Accumulate File tc_same_order. 13 | 14 | 15 | Elpi TC Solver Override TC.Solver All. -------------------------------------------------------------------------------- /apps/tc/tests/indt_to_inst.v: -------------------------------------------------------------------------------- 1 | From elpi.core Require Export ListDef. 2 | From elpi.apps Require Export tc. 3 | Global Generalizable All Variables. 4 | 5 | Elpi TC Solver Override TC.Solver All. 6 | 7 | Class ElemOf A B := elem_of: A -> B -> Prop. 8 | Class Elements A C := elements: C -> list A. 9 | 10 | Inductive elem_of_list {A} : ElemOf A (list A) := 11 | | elem_of_list_here (x : A) l : elem_of x (x :: l) 12 | | elem_of_list_further (x y : A) l : elem_of x l -> elem_of x (y :: l). 13 | Global Existing Instance elem_of_list. 14 | 15 | Inductive NoDup {A} : list A -> Prop := 16 | | NoDup_nil_2 : NoDup nil 17 | | NoDup_cons_2 x l : not (elem_of x l) -> NoDup l -> NoDup (x :: l). 18 | 19 | Module A. 20 | Class FinSet1 A C `{ElemOf A C,Elements A C} : Prop := { 21 | NoDup_elements (X : C) : NoDup (elements X) 22 | }. 23 | End A. 24 | 25 | Module B. 26 | 27 | Class FinSet2 A C `{ElemOf A C, Elements A C} : Prop := { 28 | elem_of_elements2 (X : C) x : iff (elem_of x (elements X)) (elem_of x X); 29 | NoDup_elements2 (X : C) : NoDup (elements X) 30 | }. 31 | 32 | End B. 33 | -------------------------------------------------------------------------------- /apps/tc/tests/lemma_with_max_impl.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Class A (n : nat). 4 | Instance a : A 0 := {}. 5 | 6 | Class B (n : nat). 7 | 8 | Class C (n : nat). 9 | Instance b x: C x := {}. 10 | 11 | Lemma foo: forall (x n: nat) `{A x} `{C n}, True -> B n. Admitted. 12 | Lemma bar: forall (n: nat) `{A n}, True -> B n. Admitted. 13 | 14 | Goal exists n, B n. 15 | Proof. 16 | eexists. 17 | (* Note: `{A x} and `{C n} are solved with x = 0, n remains a hole *) 18 | (* Moreover, True remains as active goal + a shelved goal remain for n *) 19 | refine (foo _ _ _). 20 | auto. 21 | Unshelve. 22 | constructor. 23 | Qed. 24 | 25 | Goal exists x, B x. 26 | Proof. 27 | eexists. 28 | (* Note: `{A x} is solved with x = 0 *) 29 | refine (bar _ _). 30 | auto. 31 | Qed. 32 | 33 | 34 | Goal exists x, C x. 35 | Proof. 36 | eexists. 37 | apply _. 38 | Unshelve. 39 | constructor. 40 | Qed. 41 | 42 | Class Decision (P : Type). 43 | 44 | Goal forall (A : Type) (P1: A -> Prop), 45 | exists (P : A -> A -> A -> Prop), forall z y , (forall x, Decision (P1 x)) 46 | -> forall x, Decision (P z y x). 47 | Proof. 48 | eexists; intros. 49 | apply _. 50 | Unshelve. 51 | auto. 52 | Qed. 53 | 54 | Elpi Tactic A. 55 | Elpi Accumulate lp:{{ 56 | msolve L _ :- coq.ltac.fail _ "[TC] fail to solve" L. 57 | }}. 58 | Goal exists n, B n. 59 | eexists. 60 | Fail apply _. 61 | Abort. 62 | 63 | 64 | -------------------------------------------------------------------------------- /apps/tc/tests/multi_var.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi tc. 2 | 3 | Class C (T : Type) : Type := {}. 4 | Axiom t : forall n m : nat, Type. 5 | 6 | Instance tC (n : nat) : C (t n n). Qed. 7 | Set Printing All. 8 | Goal C (t 0 0). apply _. Qed. 9 | 10 | Instance tC1 (n : nat) : let n' := n in C (t n n'). Qed. 11 | 12 | Goal C (t 0 (id 0)). apply _. Qed. 13 | 14 | (* Elpi Print TC.Solver "elpi.apps.tc.examples/TC.Solver". *) 15 | -------------------------------------------------------------------------------- /apps/tc/tests/nobacktrack.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Elpi Debug "simple-compiler". 4 | Set TC NameShortPath. 5 | 6 | Module A. 7 | 8 | Class C (n : nat) := {}. 9 | Elpi TC.Set_deterministic C. 10 | Elpi TC.Get_class_info C. 11 | Local Instance c_1 : C 1 | 10 := {}. 12 | Local Instance c_2 : C 2 | 1 := {}. 13 | 14 | Class D (n : nat) := {}. 15 | Local Instance d_1 : D 1 := {}. 16 | 17 | Class E (n : nat) := {}. 18 | Local Instance foo {n} : C n -> D n -> E n := {}. 19 | 20 | Elpi TC Solver Override TC.Solver All. 21 | 22 | Goal exists n, E n. 23 | eexists. 24 | Fail apply _. 25 | Abort. 26 | 27 | End A. 28 | 29 | Module B. 30 | 31 | Class A (T : Set) := f : T -> T. 32 | Elpi TC.Set_deterministic A. 33 | 34 | Global Instance A1 : A bool := {f x := x}. 35 | Global Instance A2 `(A bool) : A (bool * bool) := 36 | {f x := x}. 37 | Global Instance A3 `(A nat) : A (bool * bool) := 38 | {f x := x}. 39 | 40 | Goal A (bool * bool). apply _. Qed. 41 | 42 | End B. -------------------------------------------------------------------------------- /apps/tc/tests/out/out.v: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LPCIC/coq-elpi/acf29a35983328e062843913b48c36f2057fb59b/apps/tc/tests/out/out.v -------------------------------------------------------------------------------- /apps/tc/tests/prim_proj.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import tc. 2 | 3 | Set Primitive Projections. 4 | Record S := { sort :> Type }. 5 | Unset Primitive Projections. 6 | 7 | Class C (s : Type) := {}. 8 | 9 | Instance SC (s : S) : C s := Build_C s. 10 | -------------------------------------------------------------------------------- /apps/tc/tests/register/f1.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Elpi TC Solver Override TC.Solver All. 4 | 5 | Class A (n : nat). 6 | Instance I1 : A 1. Qed. 7 | 8 | Goal A 1. apply _. Qed. -------------------------------------------------------------------------------- /apps/tc/tests/register/f2.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.register Require Export f1. 2 | 3 | Goal A 1. apply _. Qed. 4 | 5 | Elpi TC Deactivate Observer TC.Compiler. 6 | 7 | Instance I2 : A 2. Qed. 8 | 9 | Goal A 2. Fail apply _. Abort. -------------------------------------------------------------------------------- /apps/tc/tests/register/f3.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests.register Require Import f2. 2 | 3 | (* 4 | Note that in f2, TC.Compiler has been deactivated, 5 | therefore I3 should not be added 6 | *) 7 | 8 | Instance I3 : A 3. Qed. 9 | 10 | Goal A 3. Fail apply _. Abort. 11 | 12 | Elpi Command custom_observer. 13 | Elpi Accumulate lp:{{ 14 | main L :- 15 | coq.say "Received the following event" L. 16 | }}. 17 | 18 | Elpi TC Activate Observer TC.Compiler. 19 | Elpi Register TC Compiler custom_observer. 20 | Elpi TC Activate Observer custom_observer. 21 | 22 | (* Here we have two active event listener for the instance creation: 23 | custom observer which simply prints the received event and 24 | TC.Compiler that adds I4 to the db 25 | *) 26 | Instance I4 : A 4. Qed. 27 | 28 | Goal A 4. apply _. Qed. 29 | -------------------------------------------------------------------------------- /apps/tc/tests/section_in_out.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Elpi Accumulate tc.db lp:{{ 4 | pred origial_tc o:int. 5 | }}. 6 | 7 | Elpi Command len_test. 8 | Elpi Accumulate Db tc.db. 9 | Elpi Accumulate lp:{{ 10 | % contains the number of instances that are not 11 | % imported from other files 12 | main [int Len] :- 13 | std.findall (tc.instance _ _ _ _) Insts, 14 | std.map Insts (x\r\ tc.instance _ r _ _ = x) R, 15 | WantedLength is {origial_tc} + Len, 16 | std.assert! ({std.length R} = WantedLength) 17 | "Unexpected number of instances", 18 | std.forall R (x\ sigma L\ 19 | std.assert! (count R x L, L = 1) "Duplicates in instances"). 20 | }}. 21 | 22 | Elpi Query TC.Solver lp:{{ 23 | std.findall (tc.instance _ _ _ _) Rules, 24 | std.length Rules Len, 25 | coq.elpi.accumulate _ "tc.db" (clause _ _ (origial_tc Len)). 26 | }}. 27 | 28 | Class Eqb A:= eqb: A -> A -> bool. 29 | Global Instance eqA : Eqb unit := { eqb x y := true }. 30 | 31 | Elpi len_test 1. 32 | 33 | Section A. 34 | Context (A : Type). 35 | Global Instance eqB : Eqb bool := { eqb x y := if x then y else negb y }. 36 | Elpi len_test 2. 37 | 38 | Global Instance eqC : Eqb A := {eqb _ _ := true}. 39 | Elpi len_test 3. 40 | 41 | Section B. 42 | Context (B : Type). 43 | Global Instance eqD : Eqb B := {eqb _ _ := true}. 44 | Elpi len_test 4. 45 | End B. 46 | 47 | Elpi len_test 4. 48 | 49 | End A. 50 | 51 | Elpi len_test 4. 52 | 53 | Section ClassPersistence. 54 | Section S1. 55 | Context (X : Type) (A : X). 56 | Class class (A : X). 57 | Definition x : class A. apply Build_class. Qed. 58 | Hint Resolve x : typeclass_instances. 59 | Elpi TC.AddInstances x. 60 | Goal exists x, class x. eexists. apply _. Qed. 61 | End S1. 62 | End ClassPersistence. -------------------------------------------------------------------------------- /apps/tc/tests/test_coercion_import.v: -------------------------------------------------------------------------------- 1 | From elpi.apps.tc.tests Require Import test_coercion. 2 | 3 | Import Animals.Bird1. 4 | 5 | 6 | Elpi Query TC.Solver lp:{{ 7 | true. 8 | }}. 9 | -------------------------------------------------------------------------------- /apps/tc/tests/test_eta.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import tc. 2 | 3 | Module M1. 4 | Axiom T : Type. 5 | Axiom P : T -> T -> T. 6 | 7 | Class eta (P: T -> T -> T). 8 | 9 | Instance I1: eta P. Qed. 10 | 11 | Goal eta (fun x => P x). Proof. apply _. Qed. 12 | Goal eta (fun x y => P x y). Proof. apply _. Qed. 13 | End M1. 14 | 15 | Module M2. 16 | Axiom T : Type. 17 | Axiom P1 : T -> T. 18 | Axiom P2 : T -> T -> T. 19 | 20 | Class eta (P1 : T -> T) (P2: T -> T -> T). 21 | 22 | Instance I1: eta P1 P2. Qed. 23 | 24 | Goal eta (fun x => P1 x) P2. Proof. apply _. Qed. 25 | Goal eta P1 (fun x y => P2 x y). Proof. apply _. Qed. 26 | Goal eta (fun x => P1 x) (fun x y => P2 x y). Proof. apply _. Qed. 27 | End M2. 28 | 29 | Module M3. 30 | Axiom T : Type. 31 | Axiom P : T -> T. 32 | 33 | Class eta (P: T -> T). 34 | Class aux (P: T -> T). 35 | 36 | Instance auxInst : aux (fun x => x). Qed. 37 | 38 | Instance I1: forall (P : T -> T), aux (fun x => P x) -> eta P. Qed. 39 | 40 | Goal exists P, eta (fun x => P x). Proof. eexists. apply _. Qed. 41 | End M3. 42 | 43 | -------------------------------------------------------------------------------- /apps/tc/tests/test_scope.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import tc. 2 | 3 | Section M. 4 | Class C (i : Type -> Type). 5 | 6 | Context (Q : Type -> Type). 7 | 8 | Goal C Q -> exists (T : Type -> Type), forall R, C R -> C (T). 9 | eexists. 10 | intros. 11 | Set Printing Existential Instances. 12 | assert (C Q) by auto. 13 | Elpi Trace Browser. 14 | apply _. 15 | Show Proof. 16 | Abort. 17 | End M. -------------------------------------------------------------------------------- /apps/tc/tests/test_shelve.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Class C. 4 | 5 | Instance T (n:nat) : C := {}. 6 | 7 | Elpi TC Solver Deactivate TC.Solver. 8 | 9 | 10 | (* THIS IS COQ *) 11 | Goal C. 12 | Fail apply _. 13 | eapply _. 14 | Show. 15 | Unshelve. 16 | Show. 17 | apply (T 2). 18 | Qed. 19 | 20 | (* THIS IS ELPI *) 21 | Goal C. 22 | Fail apply _. 23 | eapply _. 24 | Show. 25 | Unshelve. 26 | Show. 27 | apply (T 2). 28 | Qed. 29 | -------------------------------------------------------------------------------- /apps/tc/tests/test_tc.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Elpi TC Solver Override TC.Solver All. 4 | 5 | Class a (N: nat). 6 | Instance b : a 3. Qed. 7 | Instance c : a 4. Qed. 8 | 9 | TC.AddAllClasses. 10 | TC.AddAllInstances. 11 | 12 | Goal a 4. apply _. Qed. 13 | -------------------------------------------------------------------------------- /apps/tc/tests/test_tc_declare.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | 3 | Elpi TC Solver Override TC.Solver All. 4 | 5 | (* Base test *) 6 | Section S1. 7 | 8 | TC.Declare Class class1 (n : nat). 9 | 10 | (* TODO: here coq can solve the goal without applying Build_class1 *) 11 | Instance inst1 : class1 3. Proof. apply Build_class1. Qed. 12 | 13 | Goal exists x, class1 x. Proof. eexists. apply _. Qed. 14 | 15 | End S1. 16 | 17 | (* Deterministic class test *) 18 | Section S2. 19 | 20 | #[deterministic] TC.Declare Class class2 (n : nat). 21 | 22 | Instance inst2 : class2 1 | 0. Proof. apply Build_class2. Qed. 23 | Instance inst2' : class2 2 | 1. Proof. apply Build_class2. Qed. 24 | 25 | Class aux (i: nat). 26 | 27 | Instance inst_aux : forall n, class2 n -> aux n -> aux 3. Qed. 28 | Section S2'. 29 | Local Instance inst_aux' : aux 1. Qed. 30 | Goal aux 3. apply _. Qed. 31 | End S2'. 32 | 33 | Section S2'. 34 | Local Instance inst_aux'' : aux 2. Qed. 35 | Goal aux 3. 36 | Proof. 37 | Succeed apply (inst_aux 2 inst2' inst_aux''). 38 | (* Note: since class2 is deterministic we cannot backtrack. 39 | The first hypothesis of inst_aux is unified to inst2, 40 | this causes `aux 2` to fail. The instance inst2' is not tried 41 | due to the deterministic class *) 42 | Fail apply _. 43 | Abort. 44 | End S2'. 45 | 46 | End S2. 47 | 48 | (* Mode test *) 49 | Section S3. 50 | #[mode(i)] TC.Declare Class class3 (n : nat). 51 | Instance inst3 : class3 0. Proof. apply Build_class3. Qed. 52 | 53 | Goal exists x, class3 x. 54 | Proof. 55 | eexists. 56 | Succeed apply inst3. 57 | Fail apply _. 58 | Abort. 59 | 60 | End S3. 61 | 62 | Section S31. 63 | #[mode(o=ff)] TC.Declare Class class31 (n : nat). 64 | Instance inst31 : class31 0. Proof. apply Build_class31. Qed. 65 | 66 | Goal exists x, class31 x. 67 | Proof. 68 | eexists. 69 | Succeed apply inst31. 70 | Fail apply _. 71 | Abort. 72 | 73 | End S31. 74 | 75 | -------------------------------------------------------------------------------- /apps/tc/tests/test_tele_app.v: -------------------------------------------------------------------------------- 1 | From elpi.apps Require Import tc. 2 | (* From stdpp/telescopes.v *) 3 | 4 | (* A test where polymorphic universes are used *) 5 | 6 | Polymorphic Inductive tele : Type := 7 | | TeleO : tele 8 | | TeleS {X} (binder : X -> tele) : tele. 9 | 10 | Polymorphic Fixpoint tele_fun (TT : tele) (T : Type) : Type := 11 | match TT with 12 | | TeleO => T 13 | | TeleS b => forall x, tele_fun (b x) T 14 | end. 15 | 16 | Class FMap (X : Type -> Type). 17 | 18 | (* 19 | Since the instance is polymorphic, then the proof of the compiled elpi rule 20 | should be wrapped inside the pglobal constructor 21 | *) 22 | Polymorphic Instance tele_fmap {TT : tele} : FMap (tele_fun TT) := {}. 23 | 24 | Goal forall x, FMap (tele_fun x). 25 | intros. 26 | apply _. 27 | Show Proof. 28 | Qed. -------------------------------------------------------------------------------- /apps/tc/tests/test_unfold.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import tc. 2 | 3 | Module NAT. 4 | (* Unfold on S vs Nat.succ *) 5 | TC.Unfold Nat.succ. 6 | Class nat2 (T : nat -> nat). 7 | 8 | Elpi Accumulate TC.Solver lp:{{ 9 | % Just to print what is beeing normalized 10 | :after "firstHook" 11 | tc.normalize-ty T _ :- coq.say "Normalizing" T, fail. 12 | }}. 13 | 14 | (* The unfold is done in the goal *) 15 | Module NAT1. 16 | Instance i1 : nat2 S. Qed. 17 | Goal nat2 Nat.succ. apply _. Qed. 18 | End NAT1. 19 | 20 | (* The unfold is done at instance compilation *) 21 | Module NAT2. 22 | Instance i1 : nat2 Nat.succ. Qed. 23 | Goal nat2 S. apply _. Qed. 24 | End NAT2. 25 | 26 | (* The unfold is done on the instance and on the goal *) 27 | Module NAT3. 28 | Instance i1 : nat2 Nat.succ. Qed. 29 | Goal nat2 Nat.succ. apply _. Qed. 30 | End NAT3. 31 | End NAT. -------------------------------------------------------------------------------- /apps/tc/tests/tlc.v: -------------------------------------------------------------------------------- 1 | (* Test inspired from tlc library *) 2 | From elpi Require Import tc. 3 | 4 | Module extensionability. 5 | Notation binary A := (A -> A -> Prop). 6 | Class Extensionality (T : Type). 7 | Global Instance Extensionality_pred_2 8 | (A1 : Type) (A2 : forall (x1 : A1), Type): 9 | Extensionality (forall (x1:A1) (x2:A2 x1), Prop). Qed. 10 | 11 | Goal forall A, Extensionality (binary A). 12 | intros. 13 | apply _. 14 | Qed. 15 | End extensionability. 16 | 17 | Module SlowExecution. 18 | Set Implicit Arguments. 19 | 20 | Elpi Accumulate TC.Solver lp:{{ 21 | % :after "normalize-ty" tc.link.scope-check _ _ :- !, true. 22 | }}. 23 | 24 | Class Extensionality (A:Type) := Extensionality_make { 25 | extensionality_hyp : A -> A -> Prop; 26 | extensionality : forall (x y : A), extensionality_hyp x y -> x = y }. 27 | 28 | Section FuncExtDep. 29 | Variables (A1 : Type). 30 | Variables (A2 : forall (x1 : A1), Type). 31 | Variables (A3 : forall (x1 : A1) (x2 : A2 x1), Type). 32 | Variables (A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type). 33 | Variables (A5 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3), Type). 34 | Variables (A6 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3) (x5 : A5 x4), Type). 35 | 36 | Global Instance Extensionality_fun_1 : 37 | Extensionality (forall (x1:A1), A2 x1). Admitted. 38 | 39 | End FuncExtDep. 40 | 41 | Lemma eq_existT_same_eq (A : Type) (P : A -> Type) (p : A) (x y : P p): 42 | (existT P p x = existT P p y) = (x = y). 43 | Proof. 44 | Timeout 10 Fail refine (@extensionality _ _). 45 | Abort. 46 | End SlowExecution. 47 | -------------------------------------------------------------------------------- /apps/tc/theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.apps.tc) 3 | (package rocq-elpi) 4 | (theories elpi elpi.apps.tc.elpi) 5 | (flags -w -all -w -elpi) 6 | (plugins rocq-elpi.tc)) 7 | 8 | (include_subdirs qualified) 9 | -------------------------------------------------------------------------------- /builtin-doc/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name gen_doc) 3 | (libraries elpi_plugin)) 4 | 5 | (rule 6 | (targets 7 | coq-builtin.elpi 8 | coq-builtin-synterp.elpi 9 | elpi-builtin.elpi) 10 | (deps gen_doc.exe) 11 | (mode promote) 12 | (action (run ./gen_doc.exe))) 13 | 14 | (install 15 | (files 16 | coq-builtin.elpi 17 | coq-builtin-synterp.elpi 18 | elpi-builtin.elpi) 19 | (section doc) 20 | (package rocq-elpi)) 21 | -------------------------------------------------------------------------------- /builtin-doc/gen_doc.ml: -------------------------------------------------------------------------------- 1 | let _ = 2 | Elpi_plugin.Rocq_elpi_programs.document_builtins () 3 | -------------------------------------------------------------------------------- /coq-elpi.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Compatibility metapackage for Elpi extension language after the Rocq renaming" 4 | maintainer: ["Enrico Tassi "] 5 | authors: ["Enrico Tassi "] 6 | license: "LGPL-2.1-or-later" 7 | tags: [ 8 | "category:Miscellaneous/Coq Extensions" 9 | "keyword:λProlog" 10 | "keyword:higher order abstract syntax" 11 | "logpath:elpi" 12 | ] 13 | homepage: "https://github.com/LPCIC/coq-elpi" 14 | bug-reports: "https://github.com/LPCIC/coq-elpi/issues" 15 | depends: [ 16 | "coq-core" 17 | "rocq-elpi" {= version} 18 | ] 19 | dev-repo: "git+https://github.com/LPCIC/coq-elpi.git" 20 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, 2 | update-nixpkgs ? false, ci-matrix ? false, 3 | override ? {}, ocaml-override ? {}, global-override ? {}, 4 | bundle ? null, job ? null, inNixShell ? null, src ? ./., 5 | }@args: 6 | let auto = fetchGit { 7 | url = "https://github.com/coq-community/coq-nix-toolbox.git"; 8 | ref = "master"; 9 | rev = import .nix/coq-nix-toolbox.nix; 10 | }; 11 | in 12 | import auto ({inherit src;} // args) 13 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags (:standard -w -9 -w -32 -w -27 -w -6 -w -37 -warn-error -A)) 4 | (coq (flags -w +elpi.deprecated -w +elpi.implication-precedence -bt)))) 5 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.13) 2 | (using coq 0.8) 3 | (name rocq-elpi) 4 | ;(generate_opam_files) 5 | 6 | (source (github LPCIC/coq-elpi)) 7 | (license LGPL-2.1-or-later) 8 | (authors "Enrico Tassi ") 9 | (maintainers "Enrico Tassi ") 10 | 11 | (package 12 | (name rocq-elpi) 13 | (synopsis "Elpi extension language for Coq") 14 | (description 15 | "Coq-elpi provides a Coq plugin that embeds ELPI. It also provides \ 16 | a way to embed Coq's terms into λProlog using the Higher-Order \ 17 | Abstract Syntax approach and a way to read terms back. In addition \ 18 | to that it exports to ELPI a set of Coq's primitives, e.g. printing \ 19 | a message, accessing the environment of theorems and data types, \ 20 | defining a new constant and so on. For convenience it also provides \ 21 | a quotation and anti-quotation for Coq's syntax in λProlog. E.g., \ 22 | `{{nat}}` is expanded to the type name of natural numbers, or \ 23 | `{{A -> B}}` to the representation of a product by unfolding the \ 24 | `->` notation. Finally it provides a way to define new vernacular \ 25 | commands and new tactics.") 26 | (tags 27 | ("category:Miscellaneous/Coq Extensions" 28 | "keyword:λProlog" 29 | "keyword:higher order abstract syntax" 30 | "logpath:elpi")) 31 | (depends 32 | (ocaml (>= 4.10.0)) 33 | (elpi (and (>= 2.0.3) (< 2.1.0~))) 34 | (coq (and (>= 8.20+rc1) (< 8.21~))) 35 | ppx_optcomp 36 | (ocaml-lsp-server :with-dev-setup))) 37 | 38 | (package 39 | (name rocq-elpi-tests) 40 | (synopsis "Technical package to run tests") 41 | (description "Do not install") 42 | (depends rocq-elpi)) 43 | 44 | (package 45 | (name rocq-elpi-tests-stdlib) 46 | (synopsis "Technical package to run tests depending on Stdlib") 47 | (description "Do not install") 48 | (depends rocq-elpi rocq-stdlib)) 49 | 50 | (package 51 | (name coq-elpi) 52 | (allow_empty) 53 | (depends 54 | coq-core 55 | (rocq-elpi (= :version))) 56 | (synopsis "Compatibility metapackage for Elpi extension language after the Rocq renaming")) 57 | -------------------------------------------------------------------------------- /elpi/README.md: -------------------------------------------------------------------------------- 1 | ### coq-HOAS 2 | 3 | Documents how Coq terms are represented in Elpi. 4 | 5 | ### coq-lib 6 | 7 | Standard library of Coq specific utilities (in the coq. namespace). 8 | 9 | ### elpi-command-template 10 | 11 | Selects which files are accumulated in an `Elpi Command`. 12 | 13 | ### elpi-tactic-template 14 | 15 | Selects which files are accumulated in an `Elpi Tactic`. 16 | 17 | ### coq-elpi-checker 18 | 19 | Extends the standard type checker for Elpi programs so that it reports 20 | errors using Coq's I/O primitives. 21 | 22 | ### elpi-ltac 23 | 24 | Implementation of Ltac's like combinators in Elpi. 25 | 26 | ### elpi-reduction 27 | 28 | Implementation of reduction in Elpi. Main entry points are `whd` and `hd-beta`. 29 | 30 | ### coq-elaborator 31 | 32 | Uses the Coq type inference and unification algorithms in order to implement 33 | `of`, `unify-*` and `evar`. 34 | 35 | ### elpi-elaborator 36 | 37 | An elaborator completely written in Elpi (work in progress). It implements 38 | `of`, `unify-*` and `evar`. 39 | -------------------------------------------------------------------------------- /elpi/coq-elpi-checker.elpi: -------------------------------------------------------------------------------- 1 | /* rocq-elpi: Coq terms as the object language of elpi */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | % redirect to Coq type checking messages 6 | 7 | :before "default-typechecking-error" 8 | error [] _ :- !. 9 | :before "default-typechecking-error" 10 | error [pr L M] tt :- !, coq.error L M. 11 | :before "default-typechecking-error" 12 | error [pr L M|MS] tt :- Msgs = [pr L M|MS], all-same-loc L Msgs, !, coq.error L "At least one of the following errors holds:" {error-concat-noloc Msgs}. 13 | :before "default-typechecking-error" 14 | error Msgs tt :- !, coq.error "At least one of the following errors holds:" {error-concat Msgs}. 15 | 16 | pred error-concat i:list string, o:string. 17 | error-concat L R :- std.string.concat "\n" {std.map L error-pp-wloc} R. 18 | pred error-concat-noloc i:list string, o:string. 19 | error-concat-noloc L R :- std.string.concat "\n" {std.map L error-pp-noloc} R. 20 | 21 | pred error-pp-wloc i:pair loc string, o:string. 22 | error-pp-wloc (pr L S) R :- R is {std.any->string L} ^ " " ^ S. 23 | pred error-pp-noloc i:pair loc string, o:string. 24 | error-pp-noloc (pr _ S) R :- R is "- " ^ S. 25 | 26 | pred all-same-loc i:loc, i:list (pair loc string). 27 | all-same-loc L XS :- std.forall XS (x\sigma s\x = pr L s). 28 | 29 | :before "default-typechecking-warning" 30 | warning L M :- !, coq.warning "elpi" "elpi.typecheck" L M. 31 | -------------------------------------------------------------------------------- /elpi/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi_elpi) ; FIXME 3 | (package rocq-elpi)) 4 | 5 | (rule 6 | (target dummy.v) 7 | (deps 8 | (glob_files *.elpi)) 9 | (action 10 | (with-stdout-to %{target} 11 | (progn 12 | (run rocq_elpi_shafile %{deps}))))) 13 | 14 | (install 15 | (files 16 | (glob_files (*.elpi with_prefix coq/user-contrib/elpi_elpi/))) 17 | (section lib_root) 18 | (package rocq-elpi)) 19 | -------------------------------------------------------------------------------- /elpi/elpi-command-template-synterp.elpi: -------------------------------------------------------------------------------- 1 | /* Loaded when Elpi Command has a code accumulated at #[synterp] time */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | accumulate elpi_elpi/coq-lib-common. 6 | -------------------------------------------------------------------------------- /elpi/elpi-command-template.elpi: -------------------------------------------------------------------------------- 1 | /* Loaded when Elpi Command is used */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | accumulate elpi_elpi/coq-lib. % basic term manipulation routines 6 | accumulate elpi_elpi/elpi-reduction. % whd, hd-beta, ... 7 | accumulate elpi_elpi/elpi-ltac. % refine, or, thenl, ... 8 | 9 | -------------------------------------------------------------------------------- /elpi/elpi-tactic-template.elpi: -------------------------------------------------------------------------------- 1 | /* Loaded when Elpi Command is used */ 2 | /* license: GNU Lesser General Public License Version 2.1 or later */ 3 | /* ------------------------------------------------------------------------- */ 4 | 5 | % Since the elaborator written in Elpi is not ready, we fallback to the Coq one 6 | % accumulate engine/elaborator. % of, unify 7 | accumulate elpi_elpi/coq-elaborator. -------------------------------------------------------------------------------- /etc/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name shafile) 3 | (public_name rocq_elpi_shafile) 4 | (modules shafile) 5 | (package rocq-elpi)) 6 | 7 | (executable 8 | (name optcomp) 9 | (public_name rocq_elpi_optcomp) 10 | (modules optcomp) 11 | (libraries str) 12 | (package rocq-elpi)) 13 | 14 | (executable 15 | (name version_parser) 16 | (public_name rocq_elpi_version_parser) 17 | (modules version_parser) 18 | (libraries str elpi) 19 | (package rocq-elpi)) 20 | -------------------------------------------------------------------------------- /etc/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LPCIC/coq-elpi/acf29a35983328e062843913b48c36f2057fb59b/etc/logo.png -------------------------------------------------------------------------------- /etc/optcomp.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let v = Sys.argv.(1) in 3 | let ic = open_in Sys.argv.(2) in 4 | let only = Str.regexp "^#\\[only=\"\\([^\"]+\\)\"\\] *" in 5 | let skip = Str.regexp "^#\\[skip=\"\\([^\"]+\\)\"\\] *" in 6 | let has rex l = 7 | if Str.string_match rex l 0 then 8 | let expr = Str.matched_group 1 l in 9 | Some (Str.regexp expr, Str.replace_first rex "" l) 10 | else None in 11 | try 12 | while true do 13 | let l = input_line ic in 14 | begin match has only l, has skip l with 15 | | None, None -> print_string l 16 | | Some (r,l), None when Str.string_match r v 0 -> print_string l 17 | | Some _, None -> () 18 | | None, Some (r,_) when Str.string_match r v 0 -> () 19 | | None, Some (_,l) -> print_string l 20 | | Some _, Some _ -> assert false 21 | end; print_newline () 22 | done 23 | with End_of_file -> exit 0 -------------------------------------------------------------------------------- /etc/shafile.ml: -------------------------------------------------------------------------------- 1 | let mk_ident = 2 | String.map (function '.' | '/' | '-' -> '_' | c -> c) 3 | 4 | let () = 5 | Printf.printf "Local Set Warnings \"-abstract-large-number\".\n"; 6 | Sys.argv |> Array.iter (fun file -> 7 | Printf.printf "Definition %s := 0x%s.\n" 8 | (mk_ident file) @@ Digest.to_hex @@ Digest.file file) 9 | -------------------------------------------------------------------------------- /etc/tools/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name hash)) 3 | -------------------------------------------------------------------------------- /etc/tools/hash.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Printf.printf "%s\n%!" Digest.(to_hex (input stdin)) 3 | -------------------------------------------------------------------------------- /etc/tools/hash.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LPCIC/coq-elpi/acf29a35983328e062843913b48c36f2057fb59b/etc/tools/hash.mli -------------------------------------------------------------------------------- /etc/tracer.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LPCIC/coq-elpi/acf29a35983328e062843913b48c36f2057fb59b/etc/tracer.png -------------------------------------------------------------------------------- /etc/version_parser.ml: -------------------------------------------------------------------------------- 1 | 2 | let main () = 3 | let v = Sys.argv.(1) in 4 | let a,b,c = Elpi.API.Utils.version_parser ~what:"elpi" v in 5 | let open Format in 6 | printf "(%d,%d,%d)%!" a b c 7 | ;; 8 | 9 | main () 10 | -------------------------------------------------------------------------------- /etc/with-rocq-wrap.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -ex 4 | 5 | rocq=$(command -v rocq) 6 | # NB on cygwin "$rocq" is a cygwin path (/foo/bar) 7 | # but reading files from hash.exe needs windows paths (C:/cygwin/foo/bar) 8 | # we avoid the problem by going through stdin 9 | rocqhash=$(dune exec --root "$(dirname "$0")"/.. -- etc/tools/hash.exe < "$rocq") 10 | 11 | rm -rf .wrappers 12 | mkdir .wrappers 13 | 14 | cat > .wrappers/coqc < .wrappers/coqdep < .wrappers/coqdoc < .wrappers/coqpp < .wrappers/META.coq-core < term. 10 | 11 | % bind back abstracted subterms 12 | pred bind i:int, i:term, o:term. 13 | bind M T T1 :- M > 0, 14 | T1 = {{ fun x => lp:(B x) }}, % we build a Coq "fun .. => " 15 | N is M - 1, 16 | pi x\ % we allocate the fresh symbol for (abs M) 17 | (copy (abs M) x :- !) ==> % we schedule the replacement (abs M) -> x 18 | bind N T (B x). 19 | bind 0 T T1 :- copy T T1. % we perform all the replacements 20 | 21 | main [trm T] :- std.do! [ 22 | % example rule, abstracts all 1s. 23 | ((pi N M\ fold-map {{ 1 }} N (abs M) M :- !, M is N + 1) ==> fold-map T 0 T1 NVars), 24 | bind NVars T1 T2, 25 | coq.say {coq.term->string T} "becomes" {coq.term->string T2}, 26 | ]. 27 | 28 | 29 | }}. 30 | 31 | 32 | Elpi generalize (3 + 7). 33 | (* prints: 34 | (3 + 7) becomes (fun (x : ?e) (x0 : ?e0) => S (S x0) + S (S (S (S (S (S x)))))) 35 | *) 36 | -------------------------------------------------------------------------------- /examples/example_reduction_surgery.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file mocks up a reduction tactic unfolding only constants 3 | from a given module. 4 | *) 5 | 6 | From elpi Require Import elpi. 7 | 8 | Elpi Tactic reduce. 9 | Elpi Accumulate lp:{{ 10 | 11 | pred gref->redflag i:gref, o:coq.redflag. 12 | gref->redflag (const C) (coq.redflags.const C). 13 | 14 | solve (goal _ _ Ty _ [str M] as G) GS :- 15 | coq.locate-module M MP, 16 | coq.env.module MP GREFS, 17 | std.map-filter GREFS (x\r\x = gref r, r = (const _)) CONSTANTS, 18 | std.map CONSTANTS (gr\r\ coq.env.transitive-dependencies gr _ r) DEPS, 19 | std.fold DEPS {coq.gref.set.empty} coq.gref.set.union ALLDEPS, 20 | std.append CONSTANTS {coq.gref.set.elements ALLDEPS} All, 21 | std.map-filter All gref->redflag DELTAFLAGS, 22 | coq.redflags.add coq.redflags.nored 23 | [ coq.redflags.beta, coq.redflags.fix, coq.redflags.match | DELTAFLAGS ] 24 | F, 25 | (@redflags! F ==> coq.reduction.cbv.norm Ty Ty1), 26 | refine {{ _ : lp:Ty1 }} G GS. % to leave a vmcast one needs to call ltac1 27 | 28 | }}. 29 | 30 | 31 | 32 | Module ToRed. 33 | Definition x := 1. 34 | Definition y := 1. 35 | Definition alias := plus. 36 | End ToRed. 37 | 38 | Goal ToRed.x + ToRed.y = let z := 1 in S z. 39 | elpi reduce "ToRed". 40 | match goal with |- 2 = let z := 1 in S z => trivial end. 41 | Show Proof. 42 | Abort. 43 | -------------------------------------------------------------------------------- /rocq-elpi.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Elpi extension language for Coq" 4 | description: 5 | "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." 6 | maintainer: ["Enrico Tassi "] 7 | authors: ["Enrico Tassi "] 8 | license: "LGPL-2.1-or-later" 9 | tags: [ 10 | "category:Miscellaneous/Coq Extensions" 11 | "keyword:λProlog" 12 | "keyword:higher order abstract syntax" 13 | "logpath:elpi" 14 | ] 15 | homepage: "https://github.com/LPCIC/coq-elpi" 16 | bug-reports: "https://github.com/LPCIC/coq-elpi/issues" 17 | depends: [ 18 | "dune" {>= "3.13"} 19 | "ocaml" {>= "4.10.0"} 20 | "elpi" {>= "2.0.7" & < "2.1.0~"} 21 | ("coq" {>= "8.20+rc1" & < "8.21~"} 22 | | "rocq-core" {>= "9.0+rc1" & < "9.1~"}) 23 | "ppx_optcomp" 24 | "ocaml-lsp-server" {with-dev-setup} 25 | "odoc" {with-doc} 26 | "rocq-stdlib" {with-doc} 27 | ] 28 | build: [ 29 | ["dune" "subst"] {dev} 30 | [make "dune-files"] 31 | [ 32 | "etc/with-rocq-wrap.sh" {!coq-core:installed} 33 | "dune" 34 | "build" 35 | "-p" 36 | name 37 | "-j" 38 | jobs 39 | "@install" 40 | "@runtest" {with-test} 41 | "@doc" {with-doc} 42 | ] 43 | ] 44 | dev-repo: "git+https://github.com/LPCIC/coq-elpi.git" 45 | -------------------------------------------------------------------------------- /src/README.md: -------------------------------------------------------------------------------- 1 | # Coq Elpi plugin 2 | 3 | This directory contains the OCaml code bridging Elpi and Coq. 4 | 5 | The most interesting file is [rocq_elpi_HOAS.ml](rocq_elpi_HOAS.ml) where 6 | conversions for term, context and evar_map are provided. 7 | 8 | The exposed Coq API is in [rocq_elpi_builtins.ml](rocq_elpi_builtins.ml). 9 | 10 | -------------------------------------------------------------------------------- /src/dune.in: -------------------------------------------------------------------------------- 1 | (library 2 | (name elpi_plugin) 3 | (public_name rocq-elpi.elpi) 4 | (synopsis "Elpi") 5 | (flags :standard -w -27) 6 | (preprocessor_deps rocq_elpi_config.mlh) 7 | (preprocess 8 | (pps ppx_deriving.std ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) 9 | (libraries @@ROCQ_RUNTIME@@.plugins.ltac @@ROCQ_RUNTIME@@.vernac elpi)) 10 | 11 | (rule 12 | (target rocq_elpi_builtins_arg_HOAS.ml) 13 | (deps ../elpi/coq-arg-HOAS.elpi (package elpi)) 14 | (action (with-stdout-to %{target} 15 | (progn 16 | (echo "(* Automatically generated from %{deps}, don't edit *)\n") 17 | (echo "let code = {|\n") 18 | (cat %{deps}) 19 | (echo "|}\n"))))) 20 | 21 | (rule 22 | (target rocq_elpi_builtins_HOAS.ml) 23 | (deps ../elpi/coq-HOAS.elpi) 24 | (action (with-stdout-to %{target} 25 | (progn 26 | (echo "(* Automatically generated from %{deps}, don't edit *)\n") 27 | (echo "let code = {|\n") 28 | (cat %{deps}) 29 | (echo "|}\n"))))) 30 | 31 | (rule 32 | (target rocq_elpi_config.ml) 33 | (action (with-stdout-to %{target} 34 | (progn 35 | (echo "(* Automatically generated, don't edit *)\n") 36 | (echo "[%%import \"rocq_elpi_config.mlh\"]\n") 37 | (echo "let elpi_version = \"%{version:elpi}\"\n"))))) 38 | 39 | (rule 40 | (target rocq_elpi_config.mlh) 41 | (action (with-stdout-to %{target} 42 | (progn 43 | (echo "(* Automatically generated, don't edit *)\n") 44 | (echo "[%%define elpi ") 45 | (run rocq_elpi_version_parser %{version:elpi}) 46 | (echo "]\n"))))) 47 | 48 | 49 | (coq.pp 50 | (modules rocq_elpi_vernacular_syntax rocq_elpi_arg_syntax)) 51 | -------------------------------------------------------------------------------- /src/elpi_plugin.mlpack: -------------------------------------------------------------------------------- 1 | Rocq_elpi_config 2 | Rocq_elpi_utils 3 | Rocq_elpi_graph 4 | Rocq_elpi_HOAS 5 | Rocq_elpi_glob_quotation 6 | Rocq_elpi_name_quotation 7 | Rocq_elpi_arg_HOAS 8 | Rocq_elpi_arg_syntax 9 | Rocq_elpi_builtins_arg_HOAS 10 | Rocq_elpi_builtins_HOAS 11 | Rocq_elpi_builtins_synterp 12 | Rocq_elpi_builtins 13 | Rocq_elpi_programs 14 | Rocq_elpi_vernacular 15 | Rocq_elpi_vernacular_syntax 16 | -------------------------------------------------------------------------------- /src/rocq_elpi_builtins.mli: -------------------------------------------------------------------------------- 1 | (* rocq-elpi: Coq terms as the object language of elpi *) 2 | (* license: GNU Lesser General Public License Version 2.1 or later *) 3 | (* ------------------------------------------------------------------------- *) 4 | 5 | open Elpi.API 6 | open Rocq_elpi_utils 7 | 8 | val coq_header_builtins : BuiltIn.declaration list 9 | val coq_misc_builtins : BuiltIn.declaration list 10 | val coq_locate_builtins : BuiltIn.declaration list 11 | val coq_rest_builtins : BuiltIn.declaration list 12 | 13 | (* Clauses to be added to elpi programs when the execution is over *) 14 | 15 | val clauses_for_later_interp : (qualified_name * Ast.program * Names.Id.t list * Rocq_elpi_utils.clause_scope) list State.component 16 | 17 | val set_accumulate_to_db_interp : (loc:Loc.t -> (qualified_name * Ast.program * Names.Id.t list * Rocq_elpi_utils.clause_scope) list -> unit) -> unit 18 | val set_accumulate_text_to_db_interp : (loc:Loc.t -> (string list -> string -> Rocq_elpi_utils.clause_scope -> unit)) -> unit 19 | 20 | (* In tactic mode some APIs are disabled *) 21 | val tactic_mode : bool State.component 22 | val base : Compile.program option State.component 23 | 24 | val cache_tac_abbrev : code:qualified_name -> name:qualified_name ->unit 25 | 26 | -------------------------------------------------------------------------------- /src/rocq_elpi_glob_quotation.mli: -------------------------------------------------------------------------------- 1 | (* rocq-elpi: Coq terms as the object language of elpi *) 2 | (* license: GNU Lesser General Public License Version 2.1 or later *) 3 | (* ------------------------------------------------------------------------- *) 4 | 5 | 6 | open Elpi.API 7 | open RawData 8 | 9 | val coq : Ast.Scope.language 10 | 11 | (* The context used to interpret Var("x") nodes in all the APIs below *) 12 | val set_coq_ctx_hyps : State.t -> [> `Options ] Rocq_elpi_HOAS.coq_context * Rocq_elpi_HOAS.hyp list -> State.t 13 | 14 | val under_ctx : 15 | Names.Name.t -> term -> term option -> 16 | k:(depth:int -> State.t -> State.t * 'b * 'c) -> 17 | depth:int -> State.t -> State.t * 'b * 'c 18 | 19 | val gterm2lp : 20 | loc:Loc.t -> 21 | base:Compile.program -> 22 | Glob_term.glob_constr -> 23 | depth:int -> State.t -> State.t * term 24 | val gparams2lp : 25 | loc:Loc.t -> 26 | base:Compile.program -> 27 | Glob_term.glob_decl list -> 28 | k:(depth:int -> State.t -> State.t * term) -> 29 | depth:int -> State.t -> State.t * term 30 | val garity2lp : 31 | loc:Loc.t -> 32 | base:Compile.program -> 33 | Glob_term.glob_constr -> 34 | depth:int -> State.t -> State.t * term 35 | val grecord2lp : 36 | loc:Loc.t -> 37 | base:Compile.program -> 38 | name:string list * Names.Id.t -> 39 | constructorname:Names.Id.t option -> 40 | Glob_term.glob_constr -> 41 | (Glob_term.glob_constr * Rocq_elpi_HOAS.record_field_spec) list -> 42 | depth:int -> State.t -> State.t * term 43 | 44 | val runtime_gterm2lp : 45 | loc:Loc.t -> 46 | base:Compile.program -> 47 | Glob_term.glob_constr -> 48 | depth:int -> State.t -> term 49 | 50 | (* Used for anti-quotations *) 51 | val is_elpi_code : (Genarg.glob_generic_argument -> bool) ref 52 | val get_elpi_code : (Genarg.glob_generic_argument -> Ast.Loc.t * string) ref 53 | val is_elpi_code_appArg : (Genarg.glob_generic_argument -> bool) ref 54 | val get_elpi_code_appArg : (Genarg.glob_generic_argument -> Ast.Loc.t * string list) ref 55 | 56 | (* Hacks *) 57 | val mk_restricted_name : int -> string 58 | -------------------------------------------------------------------------------- /src/rocq_elpi_graph.mli: -------------------------------------------------------------------------------- 1 | module Graph : 2 | sig 3 | type 'a graph 4 | exception Invalid_graph of string 5 | val build : ('a * 'a list) list -> 'a graph 6 | val topo_sort : 'a graph -> 'a list 7 | val print : ('a -> string) -> 'a graph -> unit 8 | end 9 | -------------------------------------------------------------------------------- /src/rocq_elpi_name_quotation.ml: -------------------------------------------------------------------------------- 1 | (* coq-elpi: Coq terms as the object language of elpi *) 2 | (* license: GNU Lesser General Public License Version 2.1 or later *) 3 | (* ------------------------------------------------------------------------- *) 4 | 5 | module API = Elpi.API 6 | open Rocq_elpi_utils 7 | open Rocq_elpi_HOAS 8 | open Names 9 | 10 | let to_name ~loc src = 11 | if src = "_" then in_elpiast_name ~loc Name.Anonymous 12 | else in_elpiast_name ~loc (Name.Name (Id.of_string src)) 13 | 14 | (* Install the quotation *) 15 | let () = 16 | let f ~language state loc src = to_name ~loc src in 17 | let _ = API.Quotation.register_named_quotation ~descriptor:interp_quotations ~name:"name" f in 18 | let _ = API.Quotation.register_named_quotation ~descriptor:synterp_quotations ~name:"name" f in 19 | () 20 | 21 | let () = 22 | let f ~language state loc s = 23 | let src = String.sub s 1 (String.length s - 2) in 24 | to_name ~loc src in 25 | let _ = API.Quotation.declare_backtick ~descriptor:interp_quotations ~name:"Name.t" f in 26 | let _ = API.Quotation.declare_backtick ~descriptor:synterp_quotations ~name:"Name.t" f in 27 | () 28 | -------------------------------------------------------------------------------- /tests-stdlib/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (package rocq-elpi-tests-stdlib) 3 | (name elpi_tests_stdlib) 4 | (plugins rocq-elpi.elpi) 5 | (theories elpi elpi_stdlib)) 6 | 7 | ; (include_subdirs qualified) 8 | -------------------------------------------------------------------------------- /tests-stdlib/test_API_register.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | From elpi_stdlib Require Import Eqdep_dec. 3 | 4 | Inductive T : Type := a | b | f : T -> T. 5 | Axiom T_dec : forall x y : T, {x = y} + {x <> y}. 6 | Inductive V : T -> Type := V1 : V a | V2 : V b. 7 | Inductive X : Type := B : forall (x : T), V x -> X. 8 | 9 | Goal forall p q, B a p = B a q -> p = q. 10 | intros p q H. 11 | injection H. 12 | apply (inj_pair2_eq_dec T T_dec). 13 | Qed. 14 | 15 | 16 | Elpi Command foo. 17 | 18 | Elpi Query lp:{{ 19 | 20 | coq.register {{:gref T_dec}} (coq.register.scheme {{:gref T}} coq.register.scheme.eq_dec). 21 | 22 | }}. 23 | 24 | Goal forall p q, B a p = B a q -> p = q. 25 | intros p q H. 26 | injection H. 27 | apply id. 28 | Qed. 29 | -------------------------------------------------------------------------------- /tests/accumulate1.v: -------------------------------------------------------------------------------- 1 | From elpi.tests Extra Dependency "library.elpi" as library. 2 | Require Import elpi.tests.program. 3 | 4 | Elpi Accumulate program File library. 5 | -------------------------------------------------------------------------------- /tests/accumulate2.v: -------------------------------------------------------------------------------- 1 | From elpi.tests Extra Dependency "library.elpi" as library. 2 | Require Import elpi.tests.program. 3 | 4 | Elpi Accumulate program File library. -------------------------------------------------------------------------------- /tests/boom.elpi: -------------------------------------------------------------------------------- 1 | pred locate?! i:id, i:A -> located, o:A. % Locate or fail (rather than panic) 2 | pred locate? i:id, i:A -> located, o:A. % Can succeed more than once 3 | 4 | locate?! Name Pat Val :- 5 | std.mem! {coq.locate-all Name} (Pat Tmp), 6 | ( ground_term Tmp, !, Val = Tmp 7 | ; fail ). 8 | 9 | locate? Name Pat Val :- 10 | std.mem {coq.locate-all Name} (Pat Tmp), 11 | ( ground_term Tmp, Val = Tmp 12 | ; fail ). -------------------------------------------------------------------------------- /tests/bug_748.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Definition myType := Type. 4 | Variant indd : myType := Indd : indd. 5 | 6 | Definition myType_R u v := u -> v -> Type. 7 | 8 | Elpi Command foo. 9 | Elpi Accumulate " 10 | main _ :- 11 | std.assert-ok! (coq.typecheck-indt-decl (inductive ""indt_R"" tt 12 | (arity {{ myType_R indd indd }}) 13 | c1 \ 14 | [ constructor ""Indd_R"" (arity {{ lp:c1 Indd Indd }}) ])) ""error"". 15 | ". 16 | Elpi foo. 17 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi.tests) 3 | (plugins rocq-elpi.elpi) 4 | (theories elpi)) 5 | 6 | (include_subdirs qualified) 7 | 8 | (rule 9 | (target dummy.v) 10 | (deps (glob_files_rec *.elpi)) 11 | (action 12 | (with-stdout-to %{target} (echo "(* copy elpi files to _build *)")))) 13 | -------------------------------------------------------------------------------- /tests/library.elpi: -------------------------------------------------------------------------------- 1 | namespace coq { 2 | kind tm type -> type. 3 | } 4 | namespace cpp { 5 | typeabbrev bs (coq.tm int). 6 | } 7 | p. -------------------------------------------------------------------------------- /tests/perf_calls.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Definition x := 3. 4 | 5 | Elpi Command perf. 6 | Elpi Accumulate lp:{{ 7 | 8 | pred loop i:int, i:gref. 9 | loop 0 _. 10 | loop M GR :- 11 | N is M - 1, 12 | (@local! => coq.arguments.set-implicit GR [[]]). 13 | loop N GR. 14 | 15 | main [int N] :- 16 | loop N {coq.locate "x"}. 17 | 18 | }}. 19 | 20 | Elpi Export perf. 21 | 22 | Timeout 1 perf 3000. 23 | -------------------------------------------------------------------------------- /tests/program.v: -------------------------------------------------------------------------------- 1 | Require Import elpi.elpi. 2 | Require Import elpi.tests.dummy. 3 | 4 | Elpi Command program. 5 | Elpi Accumulate lp:{{ 6 | pred p. 7 | main _ :- coq.say "program", std.findall p L, coq.say L. }}. 8 | Elpi Export program. -------------------------------------------------------------------------------- /tests/test_API_arguments.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Command arguments. 4 | 5 | (***** Impargs *******************************) 6 | 7 | Module X2. 8 | 9 | Axiom imp : forall T (x:T), x = x -> Prop. 10 | Arguments imp {_} [_] _ , [_] _ _ . 11 | 12 | Elpi Query lp:{{ 13 | coq.locate "imp" I, 14 | coq.arguments.implicit I 15 | [[maximal,implicit,explicit], [implicit,explicit,explicit]], 16 | (@global! => coq.arguments.set-implicit I [[]]), 17 | coq.arguments.implicit I 18 | [[explicit,explicit,explicit]] 19 | }}. 20 | End X2. 21 | About X2.imp. 22 | 23 | Module X3. 24 | Definition foo (T : Type) (x : T) := x. 25 | Arguments foo : clear implicits. 26 | 27 | Fail Check foo 3. 28 | 29 | Elpi Query lp:{{ 30 | @global! => coq.arguments.set-default-implicit {coq.locate "foo"} 31 | }}. 32 | 33 | Check foo 3. 34 | 35 | End X3. 36 | 37 | 38 | (***** Argnames/scopes/simpl *******************************) 39 | 40 | Definition f T (x : T) := x = x. 41 | 42 | Elpi Query lp:{{ 43 | coq.arguments.set-name {coq.locate "f"} [some "S"], 44 | coq.arguments.name {coq.locate "f"} [some "S"], 45 | coq.arguments.set-implicit {coq.locate "f"} [[implicit]], 46 | coq.arguments.set-scope {coq.locate "f"} [["type"]], 47 | coq.arguments.scope {coq.locate "f"} [["type_scope"]] 48 | }}. 49 | About f. 50 | Check f (S:= bool * bool). 51 | 52 | Elpi Query lp:{{ 53 | coq.arguments.set-simplification {coq.locate "f"} (when [] (some 1)) 54 | }}. 55 | About f. 56 | Check f (S:= bool * bool). 57 | Eval simpl in f (S := bool). 58 | -------------------------------------------------------------------------------- /tests/test_API_context.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Command context. 4 | Elpi Accumulate lp:{{ 5 | main [ctx-decl Ctx] :- !, 6 | coq.env.add-context Ctx. 7 | }}. 8 | 9 | Section CA. 10 | Elpi context Context (a : nat) [b : nat] {c : nat} (d : nat := 3) (e := 4). 11 | Check eq_refl : d = 3. 12 | Check eq_refl : e = 4. 13 | Definition foo := a + b + c + d + e. 14 | End CA. 15 | Print foo. 16 | 17 | Elpi Query lp:{{ 18 | coq.arguments.implicit {coq.locate "foo"} [[explicit, implicit, maximal]]. 19 | }}. 20 | -------------------------------------------------------------------------------- /tests/test_API_new_pred.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db search.db lp:{{ 4 | 5 | pred p i:int. 6 | p 1. 7 | 8 | }}. 9 | 10 | Elpi Command search. 11 | Elpi Accumulate Db search.db. 12 | Elpi Accumulate lp:{{ 13 | main [str P, int I] :- 14 | coq.elpi.predicate P [I] Q, 15 | Q. 16 | main [str P] :- 17 | coq.elpi.predicate P [I_] Q, 18 | coq.say "Query" Q, 19 | Q, 20 | coq.say "Result" Q. 21 | }}. 22 | 23 | 24 | Elpi Command declare_pred. 25 | Elpi Accumulate lp:{{ 26 | 27 | pred make-args i:list argument, o:list (pair argument_mode string). 28 | make-args [] []. 29 | make-args [str"i",str T|A] [pr in T|L] :- make-args A L. 30 | make-args [str"o",str T|A] [pr out T|L] :- make-args A L. 31 | 32 | main [str P|Args] :- 33 | make-args Args Spec, 34 | coq.elpi.add-predicate "search.db" _ P Spec. 35 | }}. 36 | 37 | 38 | Elpi Command accumulate_pred. 39 | Elpi Accumulate Db search.db. 40 | Elpi Accumulate lp:{{ 41 | main [str P,int I] :- 42 | coq.elpi.predicate P [I] Q, 43 | coq.elpi.accumulate _ "search.db" (clause _ _ Q). 44 | }}. 45 | 46 | 47 | Elpi search "p" 1. 48 | Fail Elpi search "p" 2. 49 | Elpi accumulate_pred "p" 2. 50 | Elpi search "p" 2. 51 | 52 | Elpi declare_pred "q" "i" "int". 53 | Fail Elpi search "q" 1. 54 | Elpi accumulate_pred "q" 1. 55 | Elpi search "q" 1. 56 | Fail Elpi search "q". 57 | 58 | Elpi declare_pred "r" "o" "int". 59 | Elpi accumulate_pred "r" 1. 60 | Elpi search "r". 61 | -------------------------------------------------------------------------------- /tests/test_API_notations.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Command notations. 4 | 5 | (***** Syndef *******************************) 6 | 7 | Elpi Query lp:{{ 8 | coq.notation.add-abbreviation "abbr" 2 9 | {{ fun x _ => x = x }} tt A, 10 | coq.say A 11 | }}. 12 | 13 | About abbr. 14 | Check abbr 4 3. 15 | 16 | Elpi Query lp:{{ 17 | coq.notation.add-abbreviation "abbr2" 1 18 | {{ fun x _ => x = x }} tt _ 19 | }}. 20 | 21 | About abbr2. 22 | Check abbr2 2 3. 23 | 24 | Elpi Query lp:{{ 25 | coq.notation.abbreviation {coq.locate-abbreviation "abbr2"} [{{ fun x => x }}] T, 26 | coq.say T. 27 | }}. 28 | 29 | Elpi Query lp:{{ 30 | coq.notation.abbreviation-body {coq.locate-abbreviation "abbr2"} 1 31 | (fun _ _ x\ fun _ _ _\ app[_,_,x,x]). 32 | }}. 33 | 34 | -------------------------------------------------------------------------------- /tests/test_API_section.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Command section. 4 | 5 | (* section *) 6 | 7 | Section SA. 8 | Unset Auto Template Polymorphism. 9 | Variable a : nat. 10 | Inductive ind := K. 11 | Section SB. 12 | Variable b : nat. 13 | Let c := b. 14 | Elpi Query lp:{{ 15 | coq.env.section [CA, CB, CC], 16 | coq.locate "a" (const CA), 17 | coq.locate "b" (const CB), 18 | coq.locate "c" (const CC), 19 | coq.env.const CC (some (global (const CB))) _, 20 | coq.env.add-section-variable "d" _ {{ nat }} _, 21 | coq.env.add-section-variable "d1" _ {{ nat }} _, 22 | @local! => coq.env.add-const "e" {{ 3 }} {{ nat }} _ _. 23 | }}. 24 | About d. 25 | Definition e2 := e. 26 | End SB. 27 | Fail Check d. 28 | Fail Check d1. 29 | Check eq_refl : e2 = 3. 30 | End SA. 31 | 32 | Elpi Query lp:{{ 33 | std.do! [ coq.env.begin-section "Foo", coq.env.end-section ] 34 | }} lp:{{ 35 | coq.env.begin-section "Foo", 36 | coq.env.add-section-variable "x" _ {{ nat }} X, 37 | coq.env.section [X], 38 | coq.env.add-const "fx" (global (const X)) _ _ _, 39 | coq.env.end-section. 40 | }}. 41 | 42 | Check fx : nat -> nat. 43 | 44 | Elpi Query lp:{{ 45 | coq.env.add-const "opaque_3" {{ 3 }} _ @opaque! _ 46 | }}. 47 | 48 | About opaque_3. 49 | 50 | Fail Elpi Query lp:{{ 51 | coq.env.add-const "opaque_illtyped" {{ 3 3 }} _ @opaque! _ 52 | }}. 53 | Fail Elpi Query lp:{{ 54 | coq.env.add-const "opaque_illtyped" {{ S True }} _ @opaque! _ 55 | }}. 56 | 57 | (************* using ********************) 58 | Section Using. 59 | Variable A : bool. 60 | Elpi Query lp:{{ coq.env.add-const "foo" {{ 3 }} {{ nat }} @transparent! _ }}. 61 | Elpi Query lp:{{ @using! "All" => coq.env.add-const "bar" {{ 3 }} {{ nat }} @transparent! _ }}. 62 | End Using. 63 | Check foo : nat. 64 | Check bar : bool -> nat. 65 | 66 | -------------------------------------------------------------------------------- /tests/test_API_typecheck.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | From elpi.core Require Import ListDef. 4 | 5 | Elpi Command typecheck. 6 | 7 | (****** typecheck **********************************) 8 | 9 | Elpi Query lp:{{ 10 | coq.locate "plus" (const GR), 11 | coq.env.const GR (some BO) TY, 12 | coq.typecheck BO TY ok. 13 | }}. 14 | 15 | Elpi Query lp:{{ 16 | pi x w z\ 17 | decl x `x` {{ nat }} => 18 | def z `z` {{ nat }} x => 19 | (coq.say z, 20 | coq.typecheck z T ok, 21 | coq.say T, 22 | coq.say {coq.term->string z}, 23 | coq.say {coq.term->string T}). 24 | }}. 25 | 26 | Elpi Query lp:{{ 27 | pi x w z\ 28 | decl x `x` {{ nat }} => 29 | decl w `w` {{ nat }} => 30 | def z `z` {{ nat }} w => 31 | (coq.say z, 32 | coq.typecheck z T ok, 33 | coq.say T, 34 | coq.say {coq.term->string z}, 35 | coq.say {coq.term->string T}). 36 | }}. 37 | 38 | Elpi Query lp:{{ 39 | 40 | coq.typecheck {{ Prop Prop }} _ (error E), 41 | coq.say E. 42 | 43 | }}. 44 | 45 | 46 | Elpi Query lp:{{ 47 | coq.unify-leq {{ bool }} {{ nat }} (error Msg), 48 | coq.say Msg. 49 | }}. 50 | 51 | 52 | Elpi Query lp:{{ 53 | coq.locate "cons" GRCons, Cons = global GRCons, 54 | coq.locate "nil" GRNil, Nil = global GRNil, 55 | coq.locate "nat" GRNat, Nat = global GRNat, 56 | coq.locate "O" GRZero, Zero = global GRZero, 57 | coq.locate "list" GRList, List = global GRList, 58 | L = app [ Cons, _, Zero, app [ Nil, _ ]], 59 | LE = app [ Cons, Nat, Zero, app [ Nil, Nat ]], 60 | coq.typecheck L (app [ List, Nat ]) ok. 61 | }}. 62 | 63 | Definition nat1 := nat. 64 | 65 | Elpi Query lp:{{ coq.typecheck {{ 1 }} {{ nat1 }} ok }}. 66 | 67 | Definition list1 := list. 68 | 69 | Elpi Query lp:{{ coq.typecheck {{ 1 :: nil }} {{ list1 lp:T }} ok, coq.say T }}. 70 | 71 | Elpi Query lp:{{ coq.typecheck-ty {{ nat }} (typ U) ok, coq.say U }}. 72 | 73 | Elpi Query lp:{{ coq.typecheck-ty {{ nat }} prop (error E), coq.say E }}. 74 | 75 | -------------------------------------------------------------------------------- /tests/test_COQ_ELPI_ATTRIBUTES.v.disabled: -------------------------------------------------------------------------------- 1 | (* 2 | waiting for per-file flags 3 | 4 | (env 5 | (dev 6 | (env-vars 7 | (COQ_ELPI_ATTRIBUTES "test=yes,str=\"some-string\"")))) 8 | 9 | *) 10 | From elpi Require Import elpi. 11 | 12 | Elpi Command test. 13 | Elpi Accumulate lp:{{ 14 | 15 | main _ :- 16 | attributes A, 17 | coq.parse-attributes A [] Opts, 18 | Opts => (get-option "elpi.test" "yes", 19 | get-option "elpi.str" "some-string"). 20 | 21 | }}. 22 | 23 | Elpi Export test. 24 | 25 | test. 26 | -------------------------------------------------------------------------------- /tests/test_File1.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | Elpi File file1 lp:{{ main _ :- coq.say "hello2". }}. 3 | -------------------------------------------------------------------------------- /tests/test_File2.v: -------------------------------------------------------------------------------- 1 | From elpi.tests Require Import test_File1. 2 | 3 | Elpi File file2 lp:{{ main _ :- coq.say "hello3". }}. 4 | 5 | Elpi Command c. 6 | Elpi Accumulate lp:{{ main _ :- coq.say "hello1". }}. 7 | Elpi Accumulate File file1. 8 | Elpi Accumulate File file2. 9 | Elpi Accumulate lp:{{ main _ :- coq.say "hello4". }}. 10 | 11 | Elpi c. 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /tests/test_File3.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | Elpi File myfile lp:{{ 3 | pred locate?! i:id, i:A -> located, o:A. % Locate or fail (rather than panic) 4 | locate?! Name Pat Val :- 5 | std.mem! {coq.locate-all Name} (Pat Tmp), 6 | ( ground_term Tmp, !, Val = Tmp 7 | ; fail ). 8 | }}. 9 | 10 | Elpi Command C1. 11 | Elpi Accumulate File myfile. 12 | Elpi Accumulate lp:{{ }}. 13 | 14 | Elpi Command C2. 15 | Elpi Accumulate File myfile. 16 | Elpi Accumulate lp:{{ }}. (* Error: todbl: term contains spill: coq.locate-all Name *) 17 | 18 | #[phase="interp"] Elpi Program foo lp:{{ pred p i:gref. main _ :- coq.say "hello". }}. -------------------------------------------------------------------------------- /tests/test_File4.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ pred p o:int. }}. 4 | 5 | Elpi File common.code lp:{{ 6 | pred succ i:int, o:int. 7 | succ N M :- M is N + 1. 8 | }}. 9 | 10 | Set Warnings "+elpi". 11 | 12 | Fail Elpi Accumulate foo.db lp:{{ 13 | 14 | p X :- succ 1 X. % type of succ not defined 15 | 16 | }}. 17 | 18 | Elpi Accumulate foo.db File Signature common.code. 19 | 20 | Elpi Accumulate foo.db lp:{{ 21 | 22 | p X :- succ 1 X. 23 | 24 | }}. 25 | 26 | Elpi Command foo. 27 | Elpi Accumulate File common.code. 28 | Elpi Accumulate Db foo.db. 29 | Elpi Accumulate lp:{{ 30 | main [] :- 31 | std.findall (succ 1 _) L1, std.assert! (L1 = [succ 1 2]) "oops", 32 | std.findall (p _) L2, std.assert! (L2 = [p 2]) "oops". 33 | }}. 34 | Elpi foo. 35 | -------------------------------------------------------------------------------- /tests/test_accumulate_twice.v: -------------------------------------------------------------------------------- 1 | Require Import elpi.tests.program. 2 | Require Import elpi.tests.accumulate1. 3 | Require Import elpi.tests.accumulate2. 4 | program. -------------------------------------------------------------------------------- /tests/test_cache_async.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Command x. 4 | Elpi Accumulate lp:{{ main _ :- true. }}. 5 | 6 | (* trigger compilation *) 7 | Elpi x. 8 | 9 | (* delegated proof *) 10 | Lemma x : True. Proof. auto. Qed. 11 | -------------------------------------------------------------------------------- /tests/test_ctx_cache.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Tactic perf. 4 | Elpi Accumulate lp:{{ 5 | 6 | pred loop i:int, i:prop. 7 | loop 0 _. 8 | loop M P :- 9 | N is M - 1, 10 | P, 11 | loop N P. 12 | 13 | solve (goal _ _ _ _ [str "cache", int N]) _ :- !, 14 | loop N (coq.unify-eq {{ 0 + 0 }} {{ 0 }} ok, @pi-decl `x` {{ bool }} x\ true). 15 | solve (goal _ _ _ _ [str "nocache", int N]) _ :- !, 16 | loop N (@pi-decl `x` {{ bool }} x\ coq.unify-eq {{ 0 + 0 }} {{ 0 }} ok, true). 17 | 18 | 19 | }}. 20 | 21 | 22 | Notation t := 23 | ( 24 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * 25 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * 26 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * 27 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * 28 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * 29 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * 30 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * 31 | nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat * nat 32 | )%type. 33 | Time Goal 34 | forall (x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 : t), 35 | forall (x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 : t), 36 | forall (x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 : t), 37 | forall (x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 : t), 38 | forall (x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 : t), 39 | True. 40 | intros. 41 | Optimize Heap. 42 | Time elpi perf nocache 3000. 43 | Optimize Heap. 44 | Time elpi perf cache 3000. 45 | 46 | trivial. 47 | Qed. 48 | -------------------------------------------------------------------------------- /tests/test_glob.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Definition d1 := 3. 4 | Inductive i1 : Prop := k1. 5 | Record r1 : Type := { f1 : nat; _ : f1 = 1 }. 6 | Section A. Variable v : nat. End A. 7 | Module N1. End N1. Module M1 := N1. 8 | 9 | Elpi Command test. 10 | #[synterp] Elpi Accumulate lp:{{ 11 | main _ :- std.do! [ coq.env.begin-section "A", coq.env.end-section, coq.env.begin-module "N2" none, coq.env.end-module _]. 12 | }}. 13 | Elpi Accumulate lp:{{ 14 | main _ :- 15 | coq.env.add-const "d2" {{ 3 }} _ _ _, 16 | coq.env.add-indt (inductive "i2" tt (arity {{ Prop }}) i\[constructor "k2" (arity i) ]) _, 17 | coq.env.add-indt (record "r2" {{ Type }} "_" ( 18 | field _ "f2" {{ nat }} f2\ 19 | field _ _ {{ @eq nat lp:f2 1 }} _\ 20 | end-record)) _, 21 | coq.env.begin-section "A", 22 | coq.env.add-section-variable "v" _ {{ nat }} _, 23 | coq.env.end-section, 24 | coq.env.begin-module "N2" none, 25 | coq.env.end-module _, 26 | true. 27 | }}. 28 | 29 | Elpi Export test. 30 | test. 31 | Check d1. Check d2. 32 | Check i1. Check i2. 33 | Check k1. Check k2. 34 | Check r1. Check r2. 35 | Check f1. Check f2. 36 | Module M2 := N2. 37 | 38 | 39 | Elpi Query lp:{{ 40 | pi x\ 41 | decl x `x` {{:pat list _}} ==> decl x _ {{ list bool }}, decl x _ {{ list nat }}. 42 | }}. 43 | Fail Elpi Query lp:{{ 44 | pi x\ 45 | decl x `x` {{list _}} ==> decl x _ {{ list bool }}, decl x _ {{ list nat }}. 46 | }}. 47 | -------------------------------------------------------------------------------- /tests/test_lib.v: -------------------------------------------------------------------------------- 1 | Module lib. 2 | Definition foo := I. 3 | End lib. 4 | Check lib.foo. (* works fine *) 5 | Require Import elpi.elpi. 6 | Check lib.foo. -------------------------------------------------------------------------------- /tests/test_libobject_A.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | #[interp] Elpi Db a.db lp:{{ 4 | pred a o:term. 5 | :name "init" a {{ 0 }}. 6 | a {{ 1 }}. 7 | }}. 8 | -------------------------------------------------------------------------------- /tests/test_libobject_B.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | From elpi.tests Require Import test_libobject_A. 4 | 5 | Elpi Tactic tac. 6 | Elpi Accumulate Db a.db. 7 | Elpi Accumulate lp:{{ 8 | solve _ _ :- 9 | a X, coq.say X. 10 | }}. 11 | 12 | 13 | Ltac b := elpi tac. 14 | -------------------------------------------------------------------------------- /tests/test_libobject_C.v: -------------------------------------------------------------------------------- 1 | From elpi.tests Require Import test_libobject_B. 2 | 3 | Goal True. 4 | b. 5 | Abort. 6 | 7 | Import elpi. 8 | 9 | Elpi Accumulate a.db lp:{{ 10 | :before "init" a {{ 3 }}. 11 | }}. 12 | 13 | Goal True. 14 | b. 15 | Abort. 16 | -------------------------------------------------------------------------------- /tests/test_link_order1.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.forall L (x\ sigma N\ 21 | new_int N, 22 | %coq.say "accum" N, 23 | coq.elpi.accumulate current "foo.db" (clause _ _ (p N)) ). 24 | }}. 25 | 26 | Elpi add 10. 27 | Elpi Print foo "elpi.tests/test_link_order1". 28 | -------------------------------------------------------------------------------- /tests/test_link_order2.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.map L (x\r\sigma N\ 21 | new_int N, 22 | r = (clause _ _ (p N))) C, 23 | coq.elpi.accumulate-clauses current "foo.db" C. 24 | }}. 25 | 26 | Elpi add 10. 27 | Elpi Print foo "elpi.tests/test_link_order2". 28 | 29 | -------------------------------------------------------------------------------- /tests/test_link_order3.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.forall L (x\ sigma N\ 21 | new_int N, 22 | %coq.say "accum" N, 23 | coq.elpi.accumulate execution-site "foo.db" (clause _ _ (p N)) ). 24 | }}. 25 | 26 | Elpi add 10. 27 | Elpi Print foo "elpi.tests/test_link_order3". 28 | -------------------------------------------------------------------------------- /tests/test_link_order4.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.map L (x\r\sigma N\ 21 | new_int N, 22 | r = (clause _ _ (p N))) C, 23 | coq.elpi.accumulate-clauses execution-site "foo.db" C. 24 | }}. 25 | 26 | Elpi add 10. 27 | Elpi Print foo "elpi.tests/test_link_order4". 28 | 29 | -------------------------------------------------------------------------------- /tests/test_link_order5.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.forall L (x\ sigma N\ 21 | new_int N, 22 | %coq.say "accum" N, 23 | coq.elpi.accumulate current "foo.db" (clause _ _ (p N)) ). 24 | }}. 25 | 26 | Elpi add 5. 27 | Elpi add 5. 28 | Elpi Print foo "elpi.tests/test_link_order5". 29 | -------------------------------------------------------------------------------- /tests/test_link_order6.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.map L (x\r\sigma N\ 21 | new_int N, 22 | r = (clause _ _ (p N))) C, 23 | coq.elpi.accumulate-clauses current "foo.db" C. 24 | }}. 25 | 26 | Elpi add 5. 27 | Elpi add 5. 28 | Elpi Print foo "elpi.tests/test_link_order6". 29 | 30 | -------------------------------------------------------------------------------- /tests/test_link_order7.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.forall L (x\ sigma N\ 21 | new_int N, 22 | %coq.say "accum" N, 23 | coq.elpi.accumulate execution-site "foo.db" (clause _ _ (p N)) ). 24 | }}. 25 | 26 | Elpi add 5. 27 | Elpi add 5. 28 | Elpi Print foo "elpi.tests/test_link_order7". 29 | -------------------------------------------------------------------------------- /tests/test_link_order8.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p o:int. 5 | }}. 6 | 7 | Elpi Command foo. 8 | Elpi Accumulate Db foo.db. 9 | Elpi Accumulate lp:{{ 10 | main []. 11 | main [_] :- coq.say {std.findall (p _)}. 12 | }}. 13 | 14 | 15 | Elpi Command add. 16 | Elpi Accumulate Db foo.db. 17 | Elpi Accumulate lp:{{ 18 | main [ int M ] :- 19 | std.iota M L, 20 | std.map L (x\r\sigma N\ 21 | new_int N, 22 | r = (clause _ _ (p N))) C, 23 | coq.elpi.accumulate-clauses execution-site "foo.db" C. 24 | }}. 25 | 26 | Elpi add 5. 27 | Elpi add 5. 28 | Elpi Print foo "elpi.tests/test_link_order8". 29 | 30 | -------------------------------------------------------------------------------- /tests/test_link_order9.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | From elpi.tests Require Import test_link_order1. 3 | From elpi.tests Require Import test_link_order1. 4 | 5 | Elpi Print foo "elpi.tests/test_link_order9". 6 | 7 | -------------------------------------------------------------------------------- /tests/test_link_order_import0.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Db foo.db lp:{{ 4 | pred p i:string, i:int. 5 | 6 | :name "0" 7 | p "init" 0. 8 | }}. 9 | 10 | Elpi Program bar lp:{{ }}. 11 | Elpi Accumulate Db foo.db. -------------------------------------------------------------------------------- /tests/test_link_order_import1.v: -------------------------------------------------------------------------------- 1 | From elpi.tests Require Import test_link_order_import0. 2 | 3 | Elpi Accumulate foo.db lp:{{ 4 | :before "0" 5 | p "before" 1. 6 | 7 | :after "0" 8 | p "after" 1. 9 | }}. 10 | 11 | 12 | Elpi Query bar lp:{{ 13 | coq.elpi.accumulate _ "foo.db" (clause _ (before "0") (p "before" 11)). 14 | }}. 15 | 16 | Elpi Query bar lp:{{ 17 | coq.elpi.accumulate _ "foo.db" (clause _ (after "0") (p "after" 11)) 18 | }}. -------------------------------------------------------------------------------- /tests/test_link_order_import2.v: -------------------------------------------------------------------------------- 1 | From elpi.tests Require Import test_link_order_import0. 2 | 3 | Elpi Accumulate foo.db lp:{{ 4 | :before "0" 5 | p "before" 2. 6 | 7 | :after "0" 8 | p "after" 2. 9 | }}. 10 | 11 | Elpi Query bar lp:{{ 12 | coq.elpi.accumulate _ "foo.db" (clause _ (before "0") (p "before" 22)). 13 | }}. 14 | 15 | Elpi Query bar lp:{{ 16 | coq.elpi.accumulate _ "foo.db" (clause _ (after "0") (p "after" 22)). 17 | }}. -------------------------------------------------------------------------------- /tests/test_link_order_import3.v: -------------------------------------------------------------------------------- 1 | From elpi.tests Require Import test_link_order_import2 test_link_order_import1. 2 | 3 | Elpi Print bar "elpi.tests/test_link_order_import3". 4 | -------------------------------------------------------------------------------- /tests/test_ltac2.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import test_ltac. 2 | 3 | Print it. 4 | About it. 5 | 6 | Print elpi_subproof. 7 | About elpi_subproof. 8 | 9 | Print Assumptions it. -------------------------------------------------------------------------------- /tests/test_ltac3.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | From elpi.core Require Import ssreflect ssrfun ssrbool. 3 | 4 | Ltac ltac_foo := cut True; [ idtac | abstract (exact I) ]. 5 | 6 | Record fooType := Foo { sort :> Type; }. 7 | Canonical unit_fooType := Foo unit. 8 | 9 | Elpi Tactic fail_foo. 10 | Elpi Accumulate lp:{{ 11 | 12 | pred solve i:goal, o:list sealed-goal. 13 | solve (goal _ _ _ _ [_] as G) GS :- 14 | coq.ltac.call "ltac_foo" [] G GS. 15 | 16 | }}. 17 | 18 | 19 | Goal nat. 20 | Proof. 21 | elpi fail_foo ([the fooType of unit : Type]). 22 | exact (fun _ => 0). 23 | Qed. 24 | -------------------------------------------------------------------------------- /tests/test_ltac4.v: -------------------------------------------------------------------------------- 1 | From elpi Require Export elpi. 2 | 3 | Elpi Tactic test. 4 | Elpi Accumulate lp:{{ 5 | solve G Gs :- 6 | refine {{id _}} G Gs. 7 | }}. 8 | 9 | (* #805 *) 10 | Theorem test' : True. 11 | Proof. 12 | elpi test. (* I get one (expected) goal of type True, corresponding to the hole in term (id _), but also a shelved goal of type True...*) 13 | Unshelve. (* I get two goals here, of type True. *) 14 | Fail 2: exact I. 15 | exact I. 16 | Qed. -------------------------------------------------------------------------------- /tests/test_query_extra_dep.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | From elpi_elpi Extra Dependency "elpi_elaborator.elpi" as elab. 4 | 5 | Elpi Command test. 6 | 7 | Elpi Query lp:{{ coq.extra-dep "elab" (some P) }}. 8 | 9 | Elpi Query lp:{{ coq.extra-dep "foo" none }}. 10 | -------------------------------------------------------------------------------- /tests/test_require_bad_order.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | From elpi Require test_API2. (* forget test_API1 *) 3 | -------------------------------------------------------------------------------- /tests/test_toposort.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | Elpi Command GraphToposort. 4 | 5 | Elpi Query lp:{{ 6 | coq.elpi.toposort [pr "a" ["b"], pr "c" ["a"]] ["c", "a", "b"], 7 | coq.elpi.toposort [pr 1 [2], pr 3 [1]] [3, 1, 2]. 8 | }}. 9 | -------------------------------------------------------------------------------- /tests/test_vernacular1.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | 4 | Elpi Command test.program1. 5 | Elpi Accumulate lp:{{ 6 | main X :- coq.say "test1", foo X. 7 | }}. 8 | 9 | Elpi Command test.program2. 10 | Elpi Accumulate lp:{{ 11 | main _ :- coq.say "test2". 12 | }}. 13 | 14 | Elpi Accumulate test.program1 lp:{{ 15 | foo [S] :- coq.say S. 16 | foo [X,Y] :- coq.say X, coq.say Y. 17 | foo _ :- coq.say "too many arguments". 18 | }}. 19 | 20 | Elpi test.program2. 21 | Elpi test.program1 "hello". 22 | Elpi test.program1 "hello" -my. 23 | Elpi test.program1 "hello my" Dear. 24 | Elpi test.program1 "hello" too many args. 25 | 26 | Elpi Command test.program3. 27 | Fail Elpi Accumulate lp:{{ 28 | main. 29 | }}. 30 | (* Fail *) 31 | 32 | Elpi Command test.att. 33 | Elpi Accumulate lp:{{ 34 | 35 | main _ :- 36 | attributes A, 37 | coq.say A, 38 | A = [attribute "elpi.loc" _, attribute "elpi.phase" _, attribute "foo" (leaf-str "bar")| _], 39 | coq.parse-attributes A [att "foo" string, 40 | att "poly" bool, 41 | att-ignore-unknown] CL, 42 | coq.say CL. 43 | 44 | }}. 45 | 46 | #[foo="bar"] 47 | Elpi test.att. 48 | 49 | Elpi Export test.att. 50 | 51 | #[foo="bar",poly] test.att. 52 | #[foo="bar",poly,suppa(duppa)] test.att. 53 | 54 | Elpi Command test.axx. 55 | Elpi Accumulate lp:{{ 56 | main _ :- 57 | attributes A, coq.parse-attributes A [att "foo" attmap] CL, 58 | CL = [get-option "elpi.loc" _, get-option "elpi.phase" _, get-option "foo" [get-option "A" "3", get-option "b_2" "yes"]]. 59 | }}. 60 | 61 | Elpi Export test.axx. 62 | 63 | #[foo(A="3", b_2="yes")] test.axx. 64 | 65 | Elpi Query test.att lp:{{ X = 3 }}. 66 | 67 | Elpi Command test.scope. 68 | Elpi Accumulate lp:{{ 69 | main [trm X, str"%", str Id] :- coq.say X Id. 70 | main L :- coq.error L. 71 | }}. 72 | Elpi test.scope (_ * _)%type. 73 | Fail Elpi test.scope ((_ * _)%type). 74 | -------------------------------------------------------------------------------- /tests/test_vernacular2.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi test_vernacular1. 2 | 3 | Elpi test.program1 "hello" x. 4 | Elpi test.program1 "hello" x y. 5 | 6 | #[fwd_compat_attr] Elpi Command foo. 7 | #[fwd_compat_attr] Elpi Accumulate " main _ :- coq.say {attributes}. ". 8 | #[fwd_compat_attr] Elpi Export foo. 9 | #[fwd_compat_attr] Elpi Query lp:{{ true }}. 10 | #[fwd_compat_attr] Elpi foo. 11 | #[fwd_compat_attr] foo. 12 | 13 | (* reentrance *) 14 | 15 | Elpi Command the_command. 16 | Elpi Accumulate lp:{{ 17 | pred mk-lem i:string. 18 | mk-lem Name :- std.do! [ 19 | Lem = {{ (1 + 1 = 2)%nat }}, 20 | std.assert-ok! (coq.elaborate-skeleton Lem _ ELem) "failed", 21 | std.assert-ok! (coq.typecheck {{ lp:Bo : lp:ELem }} _) "failed", 22 | coq.ltac.collect-goals Bo [SealedGoal] [], 23 | coq.ltac.open (coq.ltac.call "ltac1_that_calls_elpi" []) SealedGoal [], 24 | % !tactic_mode should equal false here 25 | coq.env.add-const Name Bo ELem @transparent! C_, 26 | ]. 27 | 28 | main [str Name] :- std.do! [ 29 | mk-lem Name 30 | ]. 31 | }}. 32 | 33 | Elpi Export the_command. 34 | 35 | Elpi Tactic elpi_tac. 36 | Elpi Accumulate lp:{{ 37 | solve (goal _Ctx _ {{ (1 + 1 = lp:EX)%nat }} _ _) _ :- std.do! [ 38 | X = {{ 2%nat }}, 39 | std.assert-ok! (coq.elaborate-skeleton X _ EX) "failed", 40 | ]. 41 | solve _ _ :- coq.ltac.fail _ "failed". 42 | }}. 43 | 44 | 45 | Ltac ltac1_that_calls_elpi := 46 | elpi elpi_tac; 47 | reflexivity. 48 | 49 | the_command xx. 50 | -------------------------------------------------------------------------------- /theories-stdlib/Arith.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Arith. 2 | #[skip="8.20"] From Stdlib Require Export Arith. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Bool.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Bool. 2 | #[skip="8.20"] From Stdlib Require Export Bool. 3 | -------------------------------------------------------------------------------- /theories-stdlib/Eqdep_dec.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Eqdep_dec. 2 | #[skip="8.20"] From Stdlib Require Export Eqdep_dec. -------------------------------------------------------------------------------- /theories-stdlib/FunctionalExtensionality.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export FunctionalExtensionality. 2 | #[skip="8.20"] From Stdlib Require Export FunctionalExtensionality. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/List.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export List. 2 | #[skip="8.20"] From Stdlib Require Export List. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Peano.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Peano. 2 | #[skip="8.20"] From Stdlib Require Export Peano. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Permutation.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Permutation. 2 | #[skip="8.20"] From Stdlib Require Export Permutation. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Program/Basics.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq.Program Require Export Basics. 2 | #[skip="8.20"] From Stdlib.Program Require Export Basics. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Program/Syntax.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq.Program Require Export Syntax. 2 | #[skip="8.20"] From Stdlib.Program Require Export Syntax. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Program/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (target Basics.v) 3 | (deps 4 | (glob_files Basics.v.in)) 5 | (action 6 | (with-stdout-to %{target} 7 | (run rocq_elpi_optcomp "%{coq:version.major}.%{coq:version.minor}" %{deps})))) 8 | 9 | (rule 10 | (target Syntax.v) 11 | (deps 12 | (glob_files Syntax.v.in)) 13 | (action 14 | (with-stdout-to %{target} 15 | (run rocq_elpi_optcomp "%{coq:version.major}.%{coq:version.minor}" %{deps})))) -------------------------------------------------------------------------------- /theories-stdlib/Ranalysis5.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Ranalysis5. 2 | #[skip="8.20"] From Stdlib Require Export Ranalysis5. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Utf8.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Utf8. 2 | #[skip="8.20"] From Stdlib Require Export Utf8. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/Vector.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Vector. 2 | #[skip="8.20"] From Stdlib Require Export Vector. 3 | 4 | -------------------------------------------------------------------------------- /theories-stdlib/ZArith.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export ZArith. 2 | #[skip="8.20"] From Stdlib Require Export ZArith. 3 | 4 | -------------------------------------------------------------------------------- /theories/attic/dune: -------------------------------------------------------------------------------- 1 | (include_subdirs no) 2 | -------------------------------------------------------------------------------- /theories/attic/test_gen.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | 4 | Theorem fg_equal : 5 | forall (A B : Type) (f g : A -> B) (x y : A), 6 | x = y -> f = g -> f x = g y. 7 | Proof. 8 | intros A B f g x y Hxy Hfg. 9 | rewrite <- Hxy. rewrite <- Hfg. 10 | reflexivity. 11 | Qed. 12 | 13 | Definition eq_ok (A : Type) (eq : A -> A -> bool) (a b : A) := 14 | (eq a b = true <-> a = b). 15 | 16 | 17 | Inductive LVar A := 18 | | VLow : A -> LVar A 19 | | VHigh : A -> LVar A. 20 | 21 | Inductive LamC (A : Type) := 22 | | App : LamC A -> LamC A -> LamC A 23 | | Abs : LamC (LVar A) -> LamC A 24 | | Var : A -> LamC A. 25 | 26 | Inductive NList (A : Type) := 27 | | NCons : NList (A*A) -> NList A 28 | | NNil. 29 | 30 | Inductive MList (A B : Type) := 31 | | MCons : A -> B -> MList A B -> MList A B 32 | | MNil : MList A B. 33 | 34 | Inductive MTree (A : Type) := 35 | | MNode : MList A (MTree (A * A)) -> MTree A. 36 | 37 | Inductive Tp (A B C D : Type) := 38 | | C : Tp A (B*B) C (list D) -> Tp A B C D 39 | | C2 : A -> B -> C -> D -> Tp A B C D. 40 | 41 | Elpi Command test.gen. 42 | 43 | Elpi Accumulate File "attic/derive-poly.elpi". 44 | 45 | Elpi Accumulate File "attic/derive-poly-eq.elpi". 46 | Elpi Query "derive-eq ""prod"".". 47 | Elpi Accumulate "eq-set ""prod"".". 48 | Elpi Query "derive-eq ""list"".". 49 | Elpi Accumulate "eq-set ""list"".". 50 | Elpi Query "derive-eq ""Tp"".". 51 | Elpi Accumulate "eq-set ""Tp"".". 52 | Elpi Query "derive-eq ""MList"".". 53 | Elpi Accumulate "eq-set ""MList"".". 54 | Elpi Query "derive-eq ""MTree"".". 55 | Elpi Accumulate "eq-set ""MTree"".". 56 | Check MTree_equal. 57 | Print MTree_equal. 58 | 59 | Elpi Accumulate File "attic/derive-poly-map.elpi". 60 | Elpi Query "derive-map ""prod"".". 61 | Elpi Accumulate "map-set ""prod"".". 62 | Elpi Query "derive-map ""list"".". 63 | Elpi Accumulate "map-set ""list"".". 64 | Elpi Query "derive-map ""Tp"".". 65 | Elpi Accumulate "map-set ""Tp"".". 66 | Elpi Query "derive-map ""MList"".". 67 | Elpi Accumulate "map-set ""MList"".". 68 | Elpi Query "derive-map ""MTree"".". 69 | Elpi Accumulate "map-set ""MTree"".". 70 | Check MTree_map. 71 | Print MTree_map. 72 | -------------------------------------------------------------------------------- /theories/core/Bool.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Bool. 2 | #[only="8.20"] Module Datatypes. 3 | #[only="8.20"] Notation reflect := Bool.reflect. 4 | #[only="8.20"] End Datatypes. 5 | -------------------------------------------------------------------------------- /theories/core/ListDef.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export List. 2 | #[skip="8.20"] From Corelib Require Export ListDef. 3 | -------------------------------------------------------------------------------- /theories/core/Morphisms.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Morphisms. 2 | #[skip="8.20"] From Corelib Require Export Morphisms. 3 | -------------------------------------------------------------------------------- /theories/core/PosDef.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export PArith. 2 | #[skip="8.20"] From Corelib Require Export PosDef. 3 | -------------------------------------------------------------------------------- /theories/core/PrimFloat.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Floats. 2 | #[skip="8.20"] From Corelib Require Export PrimFloat. 3 | -------------------------------------------------------------------------------- /theories/core/PrimInt63.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Uint63. 2 | #[skip="8.20"] From Corelib Require Export PrimInt63. 3 | -------------------------------------------------------------------------------- /theories/core/PrimString.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require PrimString. 2 | #[skip="8.20"] From Corelib Require PrimString. 3 | 4 | Register PrimString.string as elpi.pstring. 5 | 6 | Definition eqb (s1 s2 : PrimString.string) := 7 | match PrimString.compare s1 s2 with Eq => true | _ => false end. 8 | 9 | Register eqb as elpi.pstring_eqb. 10 | -------------------------------------------------------------------------------- /theories/core/PrimStringAxioms.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export PrimStringAxioms PString. 2 | #[only="8.20"] Definition compare_ok := compare_eq. 3 | 4 | #[skip="8.20"] From Corelib Require Import ssreflect ssrbool Uint63Axioms PrimStringAxioms. 5 | #[skip="8.20"] Lemma compare_Eq_refl (s : string) : compare s s = Eq. 6 | #[skip="8.20"] Proof. 7 | #[skip="8.20"] rewrite PrimStringAxioms.compare_spec. 8 | #[skip="8.20"] elim: (to_list s) => //= x xs ->. 9 | #[skip="8.20"] rewrite Uint63Axioms.compare_def_spec /compare_def eqb_refl. 10 | #[skip="8.20"] suff: ltb x x = false by move->. 11 | #[skip="8.20"] have [+ _] := ltb_spec x x. 12 | #[skip="8.20"] by case: ltb => // /(_ isT); case: (to_Z x) => //=; elim. 13 | #[skip="8.20"] Qed. 14 | #[skip="8.20"] Lemma compare_Eq_correct (s1 s2 : string) : 15 | #[skip="8.20"] compare s1 s2 = Eq -> s1 = s2. 16 | #[skip="8.20"] Proof. 17 | #[skip="8.20"] move=> E; rewrite -[s1]of_to_list -[s2]of_to_list; congr (of_list _). 18 | #[skip="8.20"] move: E; rewrite compare_spec. 19 | #[skip="8.20"] elim: (to_list s1) (to_list s2) => [[]//|x xs IH [|y ys] //=]. 20 | #[skip="8.20"] rewrite Uint63Axioms.compare_def_spec /compare_def. 21 | #[skip="8.20"] move: (eqb_correct x y); case: eqb => [/(_ isT)->|_]. 22 | #[skip="8.20"] suff: ltb y y = false by move=> -> /IH ->. 23 | #[skip="8.20"] have [+ _] := ltb_spec y y. 24 | #[skip="8.20"] by case: ltb => // /(_ isT); case: (to_Z y) => //=; elim. 25 | #[skip="8.20"] by case: ltb. 26 | #[skip="8.20"] Qed. 27 | #[skip="8.20"] Lemma compare_ok (s1 s2 : string) : compare s1 s2 = Eq <-> s1 = s2. 28 | #[skip="8.20"] Proof. split; [apply compare_Eq_correct|intros []; apply compare_Eq_refl]. Qed. 29 | -------------------------------------------------------------------------------- /theories/core/RelationClasses.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export RelationClasses. 2 | #[skip="8.20"] From Corelib Require Export RelationClasses. 3 | -------------------------------------------------------------------------------- /theories/core/Setoid.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Setoid. 2 | #[skip="8.20"] From Corelib Require Export Setoid. 3 | -------------------------------------------------------------------------------- /theories/core/Uint63Axioms.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export Uint63. 2 | #[skip="8.20"] From Corelib Require Export Uint63Axioms. 3 | Definition eqb_correct := eqb_correct. 4 | Definition eqb_refl := eqb_refl. 5 | -------------------------------------------------------------------------------- /theories/core/ssrbool.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export ssrbool. 2 | #[skip="8.20"] From Corelib Require Export ssrbool. 3 | -------------------------------------------------------------------------------- /theories/core/ssreflect.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export ssreflect. 2 | #[skip="8.20"] From Corelib Require Export ssreflect. 3 | -------------------------------------------------------------------------------- /theories/core/ssrfun.v.in: -------------------------------------------------------------------------------- 1 | #[only="8.20"] From Coq Require Export ssrfun. 2 | #[skip="8.20"] From Corelib Require Export ssrfun. 3 | -------------------------------------------------------------------------------- /theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name elpi) 3 | (package rocq-elpi) 4 | (plugins rocq-elpi.elpi) 5 | (theories elpi_elpi)) 6 | 7 | (rule 8 | (target elpi.v) 9 | (deps 10 | (glob_files elpi.v.in)) 11 | (action 12 | (with-stdout-to %{target} 13 | (run rocq_elpi_optcomp "%{coq:version.major}.%{coq:version.minor}" %{deps})))) 14 | 15 | (include_subdirs qualified) 16 | -------------------------------------------------------------------------------- /theories/wip/dune: -------------------------------------------------------------------------------- 1 | (include_subdirs no) 2 | -------------------------------------------------------------------------------- /theories/wip/memoization.v: -------------------------------------------------------------------------------- 1 | From elpi Require Import elpi. 2 | 3 | (* Elpi does not feature tabling (memoization) but provides 4 | a very limited non-logical feature that can be used to store some (closed) data 5 | across backtracking. *) 6 | 7 | Elpi Tactic auto2. 8 | Elpi Accumulate lp:{{ 9 | % Ex falso 10 | pred exf i:goal, o:list sealed-goal. 11 | exf (goal Ctx _ Ty _ _ as G) [] :- 12 | std.exists Ctx (x\ sigma w\ x = decl V w {{False}}), 13 | refine {{ match lp:V in False return lp:Ty with end }} G []. 14 | 15 | % Constructor 16 | pred kon i:goal, o:list sealed-goal. 17 | kon (goal _ _ Ty _ _ as G) GS :- 18 | coq.safe-dest-app Ty (global (indt GR)) _, 19 | coq.env.indt GR _ _ _ _ Ks Kt, 20 | std.exists2 Ks Kt (k\ t\ 21 | coq.saturate t (global (indc k)) P, 22 | refine P G GS). 23 | 24 | % entry point; we assert no goals are left 25 | solve (goal _ _ _ _ [] as G) [] :- 26 | coq.ltac.repeat (coq.ltac.or [coq.ltac.open exf, coq.ltac.open kon]) (seal G) []. 27 | 28 | % Here we cache proved goals 29 | type item term -> term -> item. 30 | pred memo-db o:safe. 31 | 32 | pred memo-lookup i:safe, i:term, o:term. 33 | memo-lookup Safe Ty P :- open_safe Safe L, std.exists L (i\ i = item Ty P). 34 | 35 | solve (goal _ _ _ _ [str "memo"] as G) [] :- 36 | new_safe S, 37 | memo-db S => 38 | repeat-memo (coq.ltac.or[coq.ltac.open exf, coq.ltac.open kon]) G []. 39 | 40 | pred repeat-memo i:tactic, i:goal, o:list sealed-goal. 41 | 42 | repeat-memo _ (goal _ _ Ty P _) [] :- 43 | memo-db DB, memo-lookup DB Ty P, coq.say "hit" Ty, !. 44 | 45 | repeat-memo T (goal _ _ Ty Proof _ as G) GS :- 46 | T (seal G) New, coq.ltac.all (coq.ltac.open (repeat-memo T)) New GS, 47 | if (GS = []) (memo-db DB, stash_in_safe DB (item Ty Proof)) true. 48 | 49 | }}. 50 | 51 | 52 | Lemma l4 : 53 | (False \/ True) 54 | /\ (False \/ True) 55 | /\ (False \/ True) 56 | /\ (False \/ True) 57 | /\ (False \/ True) 58 | /\ (False \/ True) 59 | /\ (False \/ True) 60 | . 61 | Proof. 62 | Time elpi auto2 memo. 63 | Qed. 64 | 65 | --------------------------------------------------------------------------------