pax_global_header00006660000000000000000000000064146673423340014526gustar00rootroot0000000000000052 comment=e052cadeaace39e00f9dcef9e768fc0fa4ac1d3b coq-serapi-8.20.0-0.20.0/000077500000000000000000000000001466734233400143735ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/.github/000077500000000000000000000000001466734233400157335ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/.github/workflows/000077500000000000000000000000001466734233400177705ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/.github/workflows/ci.yml000066400000000000000000000067001466734233400211110ustar00rootroot00000000000000name: CI on: push: branches: - v8.8 - v8.9 - v8.10 - v8.11 - v8.12 - v8.13 - v8.14 - v8.15 - v8.16 - v8.17 - v8.18 - v8.19 - v8.20 - main pull_request: branches: - v8.8 - v8.9 - v8.10 - v8.11 - v8.12 - v8.13 - v8.14 - v8.15 - v8.16 - v8.17 - v8.18 - v8.19 - v8.20 - main # Allows you to run this workflow manually from the Actions tab workflow_dispatch: jobs: build: strategy: fail-fast: false matrix: ocaml-compiler: [4.12.x, 4.13.x, 4.14.x] test-target: [test] extra-opam: [coq.8.20.dev] include: - ocaml-compiler: 4.14.x test-target: test extra-opam: coq-from-git: true env: OPAMJOBS: "2" OPAMROOTISOK: "true" OPAMYES: "true" NJOBS: "2" COQ_REPOS: "https://github.com/coq/coq.git" COQ_BRANCH: "v8.20" runs-on: ubuntu-22.04 steps: - uses: actions/checkout@v4 with: submodules: true - name: Install apt dependencies run: | sudo apt-get install aptitude sudo dpkg --add-architecture i386 sudo aptitude -o Acquire::Retries=30 update -q sudo aptitude --log-resolver -o Acquire::Retries=30 install gcc-multilib libgmp-dev:i386 -y - name: Set up OCaml ${{ matrix.ocaml-compiler }} uses: avsm/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} dune-cache: true opam-pin: false opam-repositories: | default: https://opam.ocaml.org coq-core-dev: http://coq.inria.fr/opam/core-dev - name: Display OPAM Setup run: opam list - name: Install SerAPI deps run: | opam install --ignore-constraints-on=coq,coq-lsp --deps-only . - name: Install Coq via git if: ${{ matrix.coq-from-git }} run: | # We are going to install Coq in a root dir as to keep our # main working dir clean, however we need to spec the OPAM root export OPAMSWITCH="$PWD" # First we update SERAPI_COQ_HOME for future steps as per # https://docs.github.com/en/actions/reference/workflow-commands-for-github-actions#setting-an-environment-variable echo "SERAPI_COQ_HOME=$HOME/coq-$COQ_BRANCH/_build/install/default/lib/" >> $GITHUB_ENV # Clone Coq's repos git clone --depth=3 -b "$COQ_BRANCH" "$COQ_REPOS" "$HOME/coq-$COQ_BRANCH" # Note that Coq's 'make -C "$HOME/coq-$COQ_BRANCH" world' # target now builds coqide too cd "$HOME/coq-$COQ_BRANCH" # Install deps for Coq, and build Coq opam install --deps-only ./coq-core.opam opam exec -- ./configure -prefix "$HOME/coq-$COQ_BRANCH/_build/install/default/" opam exec -- make dunestrap opam exec -- dune build -p coq-core,coq-stdlib,coq - name: Extra OPAM Setup (Coq.dev, misc extra tools) if: ${{ matrix.extra-opam != '' }} run: opam install ${{ matrix.extra-opam }} - name: Build SerAPI run: | opam exec -- make -j "$NJOBS" SERAPI_COQ_HOME="$SERAPI_COQ_HOME" ls -lR _build/install/default/bin || true ls -l _build/install/default/lib/coq-serapi || true - name: Test SerAPI run: opam exec -- make -j "$NJOBS" SERAPI_COQ_HOME="$SERAPI_COQ_HOME" "${{ matrix.test-target }}" coq-serapi-8.20.0-0.20.0/.gitignore000066400000000000000000000001021466734233400163540ustar00rootroot00000000000000_build *~ js/sertop_js.js sertop/ser_version.ml .merlin *.install coq-serapi-8.20.0-0.20.0/.gitmodules000066400000000000000000000000001466734233400165360ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/.ocamlformat000066400000000000000000000000321466734233400166730ustar00rootroot00000000000000sequence-style=terminator coq-serapi-8.20.0-0.20.0/AUTHORS000066400000000000000000000001311466734233400154360ustar00rootroot00000000000000Emilio Jesús Gallego Arias Karl Palmskog Vasily Pestun Clément Pit--Claudel Kaiyu Yang coq-serapi-8.20.0-0.20.0/CHANGES.md000066400000000000000000000456471466734233400160050ustar00rootroot00000000000000## Version 0.20.0 - [serapi] (!) support for Coq 8.20, thanks to all the developers that contributed compatibility patches. - [serlib] Support `micromega_core` plugin (@ejgallego) - [serlib] Compat with ppx_deriving 6 (@ejgallego) - [serlib] Move `serlib` sources to `coq-lsp` (@ejgallego, #409) - [general] Drop support for OCaml 4.09-4.11 (@ejgallego, #409) - [serlib] Embed `serlib` from `coq-lsp` as to help 8.20 release (@ejgallego) - [meta] Add license info for sertop.el (@ejgallego, @SnarkBoojum, fixes #411) ## Version 0.19.3 - [test] Don't require math-comp to run genarg tests (@ejgallego, #399 , fixes #395 , thanks to @SnarkBoojum for the report) ## Version 0.19.2 - [serlib] Fix CPrimitives Serialization (@ejgallego, #398, fixes #397 fixes sr-lab/coqpyt#35 , thanks to @laetitia-teo and @Nfsaavedra for the bug report) ## Version 0.19.1 - [serlib] Support `btauto` Coq plugin (@ejgallego, #362) - [serlib] Support `extraction` Coq plugin (@ejgallego, @toku-sa-n, #375, fixes #371) - [general] Make licensing clearer (@ejgallego, @palmskog, @SnarkBoojum, #361, closes #266) ## Version 0.19.0 - [serapi] (!) support for Coq 8.19, thanks to all the developers that contributed compatibility patches. - [general] Cleanup old / unused code (@ejgallego, #362) ## Version 0.18.3: - [serlib] Fix CPrimitives Serialization (@ejgallego, #398, fixes #397 fixes sr-lab/coqpyt#35 , thanks to @laetitia-teo and @Nfsaavedra for the bug report) ## Version 0.18.2: - [serlib] Expose some more Ast functions required by coq-lsp's auto-build support (@ejgallego, #383) ## Version 0.18.1: - [serlib] Fix a few 8.18 piercings (!) (@ejgallego, #357) ## Version 0.18.0: - [serapi] (!) support for Coq 8.18, thanks to all the developers that contributed compatibility patches (@ejgallego and many others). - [serlib] Fix ltac2 plugin wrong piercing due to missing constructor (@ejgallego, reported by @quarkcool, #349). ## Version 0.17.3: - [serlib] Fix CPrimitives Serialization (@ejgallego, #398, fixes #397 fixes sr-lab/coqpyt#35 , thanks to @laetitia-teo and @Nfsaavedra for the bug report) ## Version 0.17.2: - [serlib] Expose some more Ast functions required by coq-lsp's auto-build support (@ejgallego, #383) ## Version 0.17.1: - [sertop] Don't initialize `CoqworkmgrApi` (@ejgallego, #340) - [serlib] Compat with Jane Street libraries >= v0.16.0 (@ejgallego, #351) ## Version 0.17.0: - [serlib] (!) Serialization format of generic arguments has changed to be conforming to usual `ppx_sexp_conv` conventions. (@ejgallego , fixes #273) - [serapi] (!) support for Coq 8.17, upstream structures seem pretty stable from 8.16, except for `Constr.Evar` (@ejgallego) - [serapi] SerAPI is now in Coq's CI (@ejgallego @alizter) ## Version 0.16.3: - [serlib] Fix JSON serialization for generic arguments (@ejgallego, #321) ## Version 0.16.2: - [sertop] Add `--impredicative-set` command line option (@dhilst , #288) - [serlib] Added support for some more plugins from coq-core (ltac2, cc, micromega, number_string_notation) (@ejgallego, #284, #306) ## Version 0.16.1: - [sertop] Allow to set `--coqlib` using the `COQLIB` environment variable. The cmdline argument option still has precedence. - [serapi] Allow to parse expressions too with `(Parse (entry Constr) $text)` (@ejgallego, fixes #272) ## Version 0.16.0: - [serapi] (!) support for Coq 8.16, see upstream changes and SerAPI test-suite changes for more information. Remarkable changes are: - kernel terms are serialized a bit differently now due to KerName being used in more places upstream. Some internal structures also changes in kernel's env, so be attentive if you are depending on them. - plugin loading is adapted for 8.16 findlib loading method (@ejgallego) - [deps] Require cmdliner >= 1.1.0 (@ejgallego) - [deps] Support Jane Street libraries v0.15.0 (@ejgallego) - [serapi] New query `Objects` to dump Coq's libobject (@ejgallego) - [serlib] Much improved yojson / json support (@ejgallego) - [serlib] Coq AST now supports ppx_hash intf (ignoring locations by default) (@ejgallego) - [serlib] Coq AST now supports ppx_compare intf (ignoring locations by default) (@ejgallego) - [serlib] Large refactoring on Serlib, using functors, see serlib/README.md (@ejgallego) - [serapi] (!) Query `Proofs` has changed type and will now return the partial terms under construction (#271 , fixes #270, @ejgallego) ## Version 0.15.1: - [serlib] Fix bad bypass of opaquetab serialization. This caused a segfault in some cases. ## Version 0.15.0: - [serapi] (!) support for Coq 8.15, see upstream changes; nothing too remarkable so far, except for `NewTip` -> `NewAddTip` in the answer response, we may want to add a compat layer for this if problematic. (#265, @ejgallego) ## Version 0.14.0: - [serapi] (!) support for Coq 8.14, see upstream changes; nothing too remarkable other than `NewDoc` will now ignore loadpaths due to new init setup upstream. (#253, @ejgallego) - [ci] SerAPI branches should be able to build now against Coq rc packages as to better integrate with Coq's platform beta release; thanks to Érik Martin-Dorel, Karl Palmskog and Théo Zimmermann for feedback. ## Version 0.13.1: - [serapi] New query `(Query () (LogicalPath file))` which will return the logical path for a particular `.v` file (@ejgallego, see also https://github.com/cpitclaudel/alectryon/pull/25) - [serapi] new `(SaveDoc opts)` command supporting saving of .vo files even when from interactive mode; note that using `--topfile` is required (fixes #238, @ejgallego, reported by Jason Gross) - [sertop] we don't link the OCaml `num` library anymore, this could have some impact on plugins (@ejgallego) - [nix] Added Nix support (#249, fixes #248, @Zimmi48, reported by @nyraghu) - [serapi] Fix COQPATH support: interpret paths as absolute (#249, @Zimmi48) - [serlib] Ignore `env` parameter in certain exceptions (#254, fixes #250, @ejgallego, reported by @cpitclaudel) - [sertop] New option `--omit_env` that will disable the serialization of Coq's super heavy global environments (#254 @ejgallego) - [build] Test OCaml 4.12 (#257 @ejgallego) - [sertop] Async mode was not working due to passing `-no-glob` to workers ## Version 0.13.0: - [serapi] (!) support for Coq 8.13, see upstream changes; in particular there are changes in the kernel representation of terms [pattern matching, new caseinvert, primitive arrays] (#232, fixes #227, @ejgallego) ## Version 0.12.1: * [serapi] (!) Bump public library versioning [breaking change] * [opam] Bump upper bound on ppx_sexp_conv to 0.15, allowing SerAPI to work with the 0.14 set of Jane Street packages. * [serapi] Fix goal printing anomaly (#230, fixes #228 @corwin-of-amber) * [sertop ] New `(Fork (fifo_in file) (fifo_out file))` command, that will (hard) fork a new SerAPI process and redirect the input / output towards the given Unix FIFOs. This API is experimental but should allow quite a few advantages to some users willing to perform speculative execution. (#210 , improves #202 , @ejgallego) - [serapi] Fix missing newline to separate goals (#235, fixes #231, @ejgallego) ## Version 0.12.0: * [general] (!) support Coq 8.12, main changes upstream related to the representation of numerals and notations. The rest of the interface does remain relative stable. (@ejgallego). ## Version 0.11.1: * [general] Require dune >= 2.0 (@ejgallego, ??) * [serapi] New query `Comments` to return all comments in a document (@ejgallego, #20? , (partially) fixes #191 , #200 ) * [general] Coq's error recovery is now disabled by default (@ejgallego , fixes #201) * [general] New option `--error-recovery` to enable error recovery (@ejgallego , #203) * [general] Bump sexplib dependency to v0.13 (@ejgallego , #204) Fixes incorrect change in #194. * [sertop] Set default value of allow-sprop to be true in agreement with upstream coq v8.11 and added option '--disallow-sprop' to optionally switch it off (--disallow-sprop forbids using the proof irrelevant SProp sort) (#199, @pestun) * [sertop] Set default value of allow-sprop to be true in agreement with upstream coq v8.11 and added option '--disallow-sprop' to optionally switch it off (--disallow-sprop forbids using the proof irrelevant SProp sort) (@pestun , #199) * [sertop] Added option `--topfile` to `sertop` to set top name from a filename (#197, @pestun) * [deps] Require sexplib >= 0.12 , fixed deprecation warnings (#194, @ejgallego) * [general] SerAPI is now tested with OCaml 4.08 and 4.09 (#195 , @ejgallego) * [sertop ] Forward port sername from 0.7.1 (@ejgallego) * [serlib ] Fix #212 "Segfault on universes" (@ejgallego, reported by @cpitclaudel , #214) * [serapi ] Fix #221 "Support COQPATH" (@ejgallego, reported by @cpitclaudel , #224) * [sertop ] Fix #222 "Support --indices-matter" (@ejgallego, reported by @cpitclaudel , #223) * [sertop ] Fix "Stack overflow in main loop" (@pestun , #216) ## Version 0.11.0: * [general] (!) support Coq 8.11, a few datatypes have changed, in particular `CoqAst` handles locations as an AST node, and the kernel type includes primitive floats (@ejgallego). * [general] (!) Now the `sertop` and `serapi` OCaml libraries are built packed, we've also bumped their compat version number (#192 @ejgallego) ## Version 0.7.1: * [sertop ] Add `sername` program for batch serialization elaborated terms Note that this utility will be deprecated in future versions, to be subsumed by `Query`. (#207, @palmskog, with help from @ejgallego) * [serlib ] Expose `QueryUtil.info_of_id` and `gen_pp_obj` in `serapi_protocol.mli` to enable using them in `sername` to retrieve serialized body-type pairs (@palmskog) * [general] Improved compat with Jane Street v0.13 toolchain * [serlib ] Only use `ssreflect` from Coq in tests (@ejgallego) ## Version 0.7.0: * [general] (!) support Coq 8.10, * [serapi] (!) `Goals` query return type has been modified due to upstream changes. (@ejgallego) * [serlib] Complete (hopefully) serialization for ssreflect ASTs. (#73 @ejgallego) * [general] Drop support for OCaml < 4.07 (#140 @ejgallego) * [serlib ] JSON serialization for kernel and AST terms (@ejgallego) * [serapi ] Add `Complete` support (@ejgallego c.f. https://github.com/coq/coq/pull/8766) * [serlib ] Serlib is now built as a wrapped module (@ejgallego) * [serapi ] (!) Goals info has been extended to print name metadata if available, cc #151 (@ejgallego , suggested by @cpitclaudel) * [serlib ] JSON support for vernac_expr (@ejgallego) * [sertop ] (!) Do as Coq upstream and load Coq's stdlib with `-R` (closes #56) * [sertop ] Follow Coq upstream and unset `indices_matter` (closes #157, thanks to @palmskog for the report) * [serapi ] (!) Improve CoqExn answer to have pretty-printed message (improves #162, thanks to @cpitclaudel for the request) * [serlib ] (!) Fix capitalization conventions for a few types in `Names` (closes #167 thanks to @corwin-of-amber for the report) * [serapi ] (!) Add bullet suggest information to goal query (@corwin-of-amber) * [sertop ] Add `--no_prelude` option (closes #176, @ejgallego, request of @darbyhaller) * [serlib ] (!) Add index to `MBId` serialization (fixes #150, @ejgallego) * [serapi ] (!) Add `sid` parameter to `Print` (helps #150, @ejgallego, reported by @cpitclaudel) * [sertop ] Add `sertok` program for batch serialization of tokens and their source locations (@palmskog) * [serapi ] (!) Add string-formatted messages to `CoqExn` and `Message` (@ejgallego closes #184 , closes #162) ## Version 0.6.1: * [serapi ] Add `Parse` command to parse a sentence; c.f. https://github.com/ejgallego/coq-serapi/issues/117 (@ejgallego) (cc: @yangky11) * [sercomp] Add "print" `--mode` to print the input Coq document (@ejgallego) (cc: @Ptival) * [serlib ] Serialize `Universe.t` (@ejgallego, request by @yangky11) * [sercomp] Merge `sercomp` and `compser`, add `--input` parameter to `sercomp` (@palmskog) (cc: @ejgallego) * [serlib ] Much improved support for serialization of `Environ.env` (@yangky11 and @ejgallego c.f. #118) * [serapi ] Make sure every command ends with `Completed`, even if it produced an exception (@brando90 and @ejgallego c.f. #124) * [sercomp] Add `--mode=kexp` to output the final kernel environment. (@ejgallego c.f. #119) * [serlib ] Serialize more internal environment fields (@ejgallego c.f. #119) * [serlib ] Improvements in serialization org (@ejgallego) * [serlib ] Serialize kernel entries (@ejgallego @palmskog) * [serlib ] Fix critical bug on `Constr` deserialization; reported by @palmskog, fix by @SkySkimmer. * [sertop] Fix backtrace printing when using `--debug` (@ejgallego) * [serlib ] Don't serialize VM values (@ejgallego, bug report by @palmskog) * [serapi ] Output location on tokenization (@ejgallego , idea by @palmskog) * [serapi ] Add basic documentation of the protocol (@ejgallego cc #109) ## Version 0.6.0: * [general] support Coq 8.9, * [general] SerAPI now uses Dune as a build system, * [opam] install `sertop.el`, * [serlib] support to serialize kernel environments, * [serapi] new query `Env` that tries to print the current kernel environment, * [serlib] correct field names for `CAst`, * [serlib] more robust support for opaque / non-serializable types (#61, #68). Thanks to @palmskog, * [serlib] new option `--exn_on_opaque` to raise an exception on non-serializable types; closes #61, thanks to @palmskog, * [serlib] serialization test-suite from https://github.com/proofengineering/serapi-tests, thanks to @palmskog, * [sercomp] add `--mode` option to better control output, * [sercomp] add `compser` for deserialization (inverse of `sercomp`) (@palmskog), * [serapi] Allow custom document creation using the `NewDoc` call. Use the `--no_init` option to avoid automatic creation on init. (@ejgallego) * [sercomp] Allow compilers to output `.vo` (@ejgallego , suggested by @palmskog) * [sercomp] Serialize top-level vernaculars with their syntactic attributes (such as location) (@ejgallego) * [serapi] Add `Assumptions` query, at the suggestion of @Armael (@ejgallego) * [sercomp] Disable error resilience mode in compilers; semantics are a bit dubious see coq/coq#9204 also #94. (@ejgallego, report by @palmskog) * [sercomp] Add `check` mode to compilers to check all proofs without outputting `.vo`. (@palmskog) * [sercomp] Add "hacky" `--quick` option to skip checking of opaque proofs. (@ejgallego, request by @palmskog) * [sercomp] Add `--async_workers` option to set maximum number of parallel async workers. (@palmskog) * [sertop] Stop linking Coq plugins statically and load `serlib` plugins when Coq plugins are loaded instead (@ejgallego, review by @palmskog) ## Version 0.5.7: * [serlib] Fixed serializers for more tactics data, add support for `ground` plugin (#68). Thanks again to @palmskog for the report. ## Version 0.5.6: * [serlib] Fixed serializers for some tactics data (#66) Thanks to @palmskog for the report. ## Version 0.5.5: * [serlib] Be more lenient when parsing back `Id.t` as to accommodate hacks in the Coq AST (#64) Thanks to @palmskog for the report. ## Version 0.5.4: * [serlib] Fix critical bug in handling of abstract type (#60) ## Version 0.5.3: * [sertop] Support for `-I` option (`--ml-include-path`). ## Version 0.5.2: * [serlib] Compatibility with OCaml 4.07.0 [problems with `Stdlib` packing] ## Version 0.5.1: * [serlib] (basic) support for serialization of the ssreflect grammar, * [serapi] `(Query () (Ast n))` is now `(Query ((sid n)) Ast)`, * [serapi] remove broken deprecated `SetOpt` and `LibAdd` commands, * [doc] Improved man page. * [js] Miscellaneous improvements on the js build. ## Version 0.5.0: * [general] support Coq 8.8, use improved document API, * [sertop] By default `sertop` will create a new document with `doc_id` 0, * [sertop] new debug options, see `sertop --help`. ## Version 0.4: * [general] support Coq 8.7 , make use of improved upstream API, * [sertop] support `-R` and `-Q` options, note the slightly different syntax wrt Coq upstream: `-R dir,path` in place of `-R dir path`, * [serlib] support serialization of generic arguments [#41], * [serapi] `(ReadFile file)`: hack to load a completed file. ## Version 0.2: * Better Query/Object system. ## Version 0.1: * Serialization-independent protocol core, * [js] Javascript worker, * [lib] Better Prelude support, * [serlib] Full Serialization of generic arguments, * [proto] Add is not a synchronous call anymore, * [proto] Refactor into a flat command hierarchy, * [proto] More useful queries, * [proto] Guarantee initial state is 1, * [proto] Support for ltac profiling, * [proto] Printing: add depth limiting, * [proto] Better handling of options in the sexp backend. ## Version 0.03: * **[done]** Implicit arguments. * **[done]** Coq Workers support. * **[done]** Advanced Sentence splitting `(Parse (Sentence string))`, which can handle the whole document. ## Version 0.02: * **[done]** Serialization of the `Proof.proof` object. * **[done]** Improve API: add options. * **[done]** Improve and review printing workflow. * **[done]** `(Query ((Prefix "add") (Limit 10) (PpStr)) $ObjectType)` * **[done]** Basic Sentence splitting `(Parse num string))`, retuns the first num end of the sentences _without_ executing them. This has pitfalls as parsing is very stateful. * **[done]** Basic completion-oriented Search support `(Query () Names)` * **[done]** Better command line parsing (`Cmdliner`, `Core` ?) * **[partial]** Print Grammar tactic. `(Query ... (Tactics))`. Still we need to decide on: `Coq.Init.Notations.instantiate` vs `instantiate`, the issue of `Nametab.shortest_qualid_of_global` is a very sensible one for IDEs coq-serapi-8.20.0-0.20.0/CODE_OF_CONDUCT.md000066400000000000000000000067461466734233400172070ustar00rootroot00000000000000The SerAPI project aims to be a fun and safe space where everybody is extremely welcome to participate and discuss. There will be zero tolerance to any kind of inappropriate behavior. Lets us all have fun. -- EJGA # Contributor Covenant Code of Conduct ## Our Pledge In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, sex characteristics, gender identity and expression, level of experience, education, socio-economic status, nationality, personal appearance, race, religion, or sexual identity and orientation. ## Our Standards Examples of behavior that contributes to creating a positive environment include: * Using welcoming and inclusive language * Being respectful of differing viewpoints and experiences * Gracefully accepting constructive criticism * Focusing on what is best for the community * Showing empathy towards other community members Examples of unacceptable behavior by participants include: * The use of sexualized language or imagery and unwelcome sexual attention or advances * Trolling, insulting/derogatory comments, and personal or political attacks * Public or private harassment * Publishing others' private information, such as a physical or electronic address, without explicit permission * Other conduct which could reasonably be considered inappropriate in a professional setting ## Our Responsibilities Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. ## Scope This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at e@x80.org. All complaints will be reviewed and investigated and will result in a response that is deemed necessary and appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. ## Attribution This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html [homepage]: https://www.contributor-covenant.org For answers to common questions about this code of conduct, see https://www.contributor-covenant.org/faq coq-serapi-8.20.0-0.20.0/CONTRIBUTING.md000066400000000000000000000031671466734233400166330ustar00rootroot00000000000000## Contributing to SerAPI Thanks for willing to contribute to SerAPI! Contributing is usually as easy as opening a pull request, issue, or dropping by the Gitter channel and letting us know what you think of the tool. Nothing special has to be kept in mind, other than standard OCaml practice, we usually follow `ocp-indent` guidelines, but we are liberal in some places in particular with regards to intra-line indentation. We prefer GPG signed commits as well as `Signed-off-by` commits. ## Releasing SerAPI As of today, SerAPI is released using a standard process based on `dune-release`; to do a release, it should suffice to do: ``` $ dune-release tag $version $ dune-release ``` where `$version` is `$coq-version+$serapi_version`, for example `8.16.2+0.16.4`. Note that `dune-release` requires you to setup a github token, see `dune-release` docs for more details. **Important**: note that `dune-release` will automatically generate the changelog from `CHANGES.md`, please keep the formatting tidy in that file! Note that bug https://github.com/ejgallego/coq-serapi/issues/208 may require you to edit the opam-repository PR if their linter fails [seems fixed as of today, but OMMV] ### Commit tag conventions [work in progress]: We have somme - [serlib] : Serialization lib. - [test] : Adding or modifying a test. - [sertop] : Sexp Toplevel. - [doc] : Documentation. - [build] : Build system. - [misc] : Code refactoring, miscellanenous - [proto] : Core protocol. - [control] : STM protocol. - [query] : Query protocol. - [parse] : Parsing protocol. - [print] : Printing protocol. - [js] : Javascript version. coq-serapi-8.20.0-0.20.0/LICENSE000066400000000000000000000023231466734233400154000ustar00rootroot00000000000000Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: coq-serapi Upstream-Contact: Emilio J. Gallego Arias Source: https://github.com/ejgallego/coq-serapi License: LGPL-2.1+ Copyright: 2016-2023, MINES ParisTech / Inria / others Authors: Emilio J. Gallego Arias, Karl Palmskog, Clément Pit-Claudel, Kaiyu Yang Files: sertop/js_sexp_printer.ml* License: MIT Copyright: Copyright (c) 2005--2023 Jane Street Group, LLC Files: sertop/sertop.el License: GPL-v3 Copyright: Copyright (C) 2016 Clément Pit-Claudel Files: serlib/* serapi/* sertop/ser* sertop/comp* License: LGPL-2.1+ Copyright: 2016-2023, MINES ParisTech / Inria / others Files: notes/* License: LGPL-2.1+ / CC-BY-SA 3.0 Files: tests/genarg/* Authors: Karl Palmskog Licence: Derived from many projects as test cases, falls into fair-use Files: tests/genarg/LibTactics.v Authors: Arthur Chargueraud Licence: LGPL-v3 Files: tests/genarg/* Authors: Karl Palmskog Licence: Derived from many projects as test cases, falls into fair-use Comment: the intent is to be compatible with Coq's license. Note that the LGPL-2.1+ allows to treat the code as GPL-3+ , we explicitly ack that here. coq-serapi-8.20.0-0.20.0/Makefile000066400000000000000000000032151466734233400160340ustar00rootroot00000000000000.PHONY: clean all serlib sertop sercomp force js-dist js-release build build-install test doc # Leave empty to use OPAM-installed Coq SERAPI_COQ_HOME ?= # SERAPI_COQ_HOME=/home/egallego/external/coq-master/_build/install/default/lib/ ifneq ($SERAPI_COQ_HOME,) export OCAMLPATH := $(SERAPI_COQ_HOME):$(OCAMLPATH) SP_PKGS=coq-serapi else SP_PKGS=coq-serapi endif all: build GITDEPS=$(ls .git/HEAD .git/index) sertop/ser_version.ml: $(GITDEPS) echo "let ser_git_version = \"$(shell git describe --tags || cat VERSION)\";;" > $@ build: dune build --root . --only-packages=$(SP_PKGS) @install check: dune build --root . @check build-install: dune build coq-serapi.install # build is required as otherwise the serlib plugins won't be in scope # for testing; we should really add the package dep to dune test files test: build dune runtest --root . doc: dune build @doc-private @doc browser: google-chrome _build/default/_doc/_html/index.html sertop: build dune exec -- rlwrap sertop vendor/coq-lsp: $(error Submodules not initialized, please do "make submodules-init") .PHONY: submodules-init submodules-init: git submodule update --init # Deinitialize submodules .PHONY: submodules-deinit submodules-deinit: git submodule deinit -f --all # Update submodules from upstream .PHONY: submodules-update submodules-update: (cd vendor/coq-lsp && git checkout main && git pull upstream main) ##################################################### # Misc clean: rm -f sertop/ser_version.ml dune clean demo-sync: rsync -avzp --delete js/ /home/egallego/x80/rhino-hawk/ cp /home/egallego/x80/rhino-hawk/term.html /home/egallego/x80/rhino-hawk/index.html coq-serapi-8.20.0-0.20.0/README.md000066400000000000000000000376121466734233400156630ustar00rootroot00000000000000**Note**: Coq SerAPI has now stopped development, the 0.20 release for Coq 8.20 will be the last managed by us. Coq SerAPI has been succeeded by [coq-lsp](https://github.com/ejgallego/coq-lsp/), which solves many longstanding issues and feature requests. See https://github.com/ejgallego/coq-serapi/issues/252 for more information. The `serlib` component of this repository now lives in the `coq-lsp` repository.. We'd like to thanks all the people that have contributed in one way or another to SerAPI after all these years, without you neither SerAPI or `coq-lsp` would have been possible. ## SerAPI: Machine-Friendly, Data-Centric Serialization for Coq [![Build Status][action-badge]][action-link] [![Zulip][zulip-badge]][zulip-link] [action-badge]: https://github.com/ejgallego/coq-serapi/actions/workflows/ci.yml/badge.svg?branch=v8.16 [action-link]: https://github.com/ejgallego/coq-serapi/actions/workflows/ci.yml?query=branch%3Av8.16 [zulip-badge]: https://img.shields.io/badge/Zulip-chat-informational.svg [zulip-link]: https://coq.zulipchat.com/#narrow/stream/256331-SerAPI To install with opam: ``` $ opam install coq-serapi $ sertop --help ``` Alternatively, if you use Nix: ``` $ nix-shell -p coq_8_13 coqPackages_8_13.serapi $ sertop --help ``` SerAPI is a library for machine-to-machine interaction with the [Coq proof assistant](https://coq.inria.fr), with particular emphasis on applications in IDEs, code analysis tools, and machine learning. SerAPI provides automatic serialization of Coq's internal [OCaml](https://ocaml.org) datatypes from/to [JSON](https://www.json.org) or [S-expressions](https://en.wikipedia.org/wiki/S-expression) (sexps). SerAPI is a proof-of-concept and should be considered alpha-quality. However, it is fully functional and supports, among other things, asynchronous proof checking, full-document parsing, and serialization of Coq's core datatypes. SerAPI can also be run as [WebWorker](https://developer.mozilla.org/en-US/docs/Web/API/Web_Workers_API/Using_web_workers) thread, providing a self-contained Coq system inside the browser. Typical load times in Google Chrome are less than a second. The main design philosophy of SerAPI is to **make clients' lives easy**, by providing a convenient, robust interface that hides most of the scary details involved in interacting with Coq. Feedback from Coq users and developers is very welcome and _intrinsic_ to the project. We are open to implementing new features and exploring new use cases. ### Documentation and Help: - [Protocol Documentation](http://ejgallego.github.io/coq-serapi/coq-serapi/Serapi/Serapi_protocol/) - [interface file](serapi/serapi_protocol.mli) - [SerAPI's FAQ](notes/FAQ.md) - [technical report](https://hal-mines-paristech.archives-ouvertes.fr/hal-01384408) - [issue tracker](https://github.com/ejgallego/coq-serapi/issues) - [Zulip chat](https://coq.zulipchat.com/#narrow/stream/256331-SerAPI) - [Gitter chat](https://gitter.im/coq-serapi/Lobby) channel (legacy) - [mailing list](https://x80.org/cgi-bin/mailman/listinfo/jscoq) **API WARNING:** _The protocol is experimental and may change often_. ### Quick Overview and Install: SerAPI can be installed as the [OPAM](https://opam.ocaml.org) package `coq-serapi` or the [Nix](https://nixos.org) package `coqPackages_8_13.serapi`. See [build instructions](notes/build.md) for manual installation. The experimental [in-browser version](https://x80.org/rhino-hawk) is also online. SerAPI provides an interactive "Read-Print-Eval-Loop" `sertop`, a batch-oriented compiler `sercomp`, and a batch-oriented tokenizer `sertok`. See the manual pages and `--help` pages of each command for more details. To get familiar with SerAPI we recommend launching the `sertop` REPL, as it provides a reasonably human-friendly experience: ``` $ rlwrap sertop --printer=human ``` You can then input commands. `Ctrl-C` will interrupt a busy Coq process in the same way it interrupts `coqtop`. The program `sercomp` provides a command-line interface to some key functionality of SerAPI and can be used for batch processing of Coq documents, e.g., to serialize Coq source files from/to lists of S-expressions of Coq vernacular sentences. See `sercomp --help` for some usage examples and an overview of the main options. The program `sertok` provides similar functionality at the level of Coq source file tokens. ### Protocol Commands: Interaction with `sertop` is done using _commands_, which can be optionally tagged in the form of `(tag cmd)`; otherwise, an automatic tag will be assigned. For every command, SerAPI **will always** reply with `(Answer tag Ack)` to indicate that the command was successfully parsed and delivered to Coq, or with a `SexpError` if parsing failed. There are three categories of [commands](serapi/serapi_protocol.mli#L147): - **Document manipulation:** `Add`, `Cancel`, `Exec`, ...: these commands instruct Coq to perform some action on the current document. Every command will produce zero or more different _tagged_ [answers](serapi/serapi_protocol.mli#52), and a final answer `(Answer tag Completed)`, indicating that there won't be more output. SerAPI document commands are an evolution of the OCaml STM API, [here](https://github.com/ejgallego/jscoq/blob/master/etc/notes/coq-notes.md) and [here](https://github.com/siegebell/vscoq/blob/master/CoqProtocol.md) you can find a few informal notes on how it works. We are working on a more detailed specification, for now you can get some more details in the issue tracker. - **Queries:** `(Query ((opt value) ...) kind)`: Queries stream Coq objects of type `kind`. This can range from options, goals and hypotheses, tactics, etc. The first argument is a list of options: `preds` is a list of conjunctive filters, `limit` specifies how many values the query may return. `pp` controls the output format: `PpSer` for full serialization, or `PpStr` for "pretty printing". For instance: ```lisp (tag (Query ((preds (Prefix "Debug")) (limit 10) (pp PpSexp)) Option)) ``` will stream all Coq options that start with "Debug", limiting to the first 10 and printing the full internal Coq datatype: ```lisp (CoqOption (Default Goal Selector) ((opt_sync true) (opt_depr false) (opt_name "default goal selector") (opt_value (StringValue 1)))) ... ``` Options can be omitted, as in: `(tag (Query ((limit 10)) Option))`, and currently supported queries can be seen [here](serapi/serapi_protocol.mli#L118) - **Printing:** `(Print opts obj)`: The `Print` command provides access to the Coq pretty printers. Its intended use is for printing (maybe IDE manipulated) objects returned by `Query`. ### Roadmap and Developer organization: SerAPI is organized in branches corresponding to upstream Coq versions; usually, branch v8.XX is compatible with Coq 8.XX, and corresponds to SerAPI 0.XX. These branches are stable and can be relied upon. The branch `main` tracks Coq `master` branch, and it is not a stable branch; force pushes and random rebases can happen there; handle with care! We are working on fixing this problematic setup, which is that way as in the past such branch used to be "private", but now that SerAPI is in Coq's CI the development workflow has changed, with developer submitting PRs to it. These days, most work related to SerAPI is directly happening over [Coq's upstream](https://github.com/coq/coq) itself. The main objective is to improve the proof-document model; building a rich query language will be next. See the [roadmap issue]() in our bug tracker for more information about roadmap and the [Developer Information](#Developer-information) section for more details on the development setup. ### Clients and Users: SerAPI has been used in a few contexts already, we provide a few pointers here, feel free to add your own! - [jsCoq](https://github.com/ejgallego/jscoq) allows you to run Coq in your browser. jsCoq is the predecessor of SerAPI and will shortly be fully based on it. - [mCoq](https://github.com/EngineeringSoftware/mcoq) is a tool for mutation analysis of Coq projects, based on serializing and deserializing Coq code via SerAPI. See the accompanying [tool paper](https://users.ece.utexas.edu/~gligoric/papers/JainETAL20mCoqTool.pdf), and the [research paper](https://users.ece.utexas.edu/~gligoric/papers/CelikETAL19mCoq.pdf) which describes and evaluates the technique. - [elcoq](https://github.com/cpitclaudel/elcoq), an emacs technology demo based on SerAPI by [Clément Pit-Claudel](https://github.com/cpitclaudel). `elcoq` is not fully functional but illustrates some noteworthy features of SerAPI. - [PeaCoq](https://github.com/Ptival/PeaCoq), a Coq IDE for the browser, has an experimental branch that uses SerAPI. - [GrammaTech's Software Evolution Library (SEL)](https://grammatech.github.io/sel/) provides tools for programmatically modifying and evaluating software. SEL operates over multiple software representations including source code in several languages and compiled machine code. Its Coq module uses SerAPI to serialize Coq source code into ASTs, which are parsed into Common Lisp objects for further manipulation. GrammaTech uses this library to synthesize modifications to software so that it satisfies an objective function, e.g., a suite of unit tests. SerAPI support was added to SEL by Rebecca Swords. - [CoqGym](https://github.com/princeton-vl/CoqGym) is a Coq-based learning environment for theorem proving. It uses SerAPI to interact with Coq and perform feature-extraction. Its author notes: > CoqGym relies heavily on SerAPI for serializing the internal structures of Coq. > I tried to use Coq's native printing functions when I started with this project, > but soon I found SerAPI could save a lot of the headaches with parsing Coq's output. > Thanks to SerAPI authors, this project wouldn't be possible (or at least in its current form) without SerAPI. See also the [paper](https://arxiv.org/abs/1905.09381) describing CoqGym. - [Proverbot9001](https://github.com/UCSD-PL/proverbot9001) is a proof search system based on machine learning techniques, and uses SerAPI to interface with Coq. See also the [paper](https://arxiv.org/abs/1907.07794) describing the system. - [Roosterize](https://github.com/EngineeringSoftware/roosterize) is a tool for suggesting lemma names in Coq projects based on machine learning. See the [paper](https://arxiv.org/abs/2004.07761) describing the technique and tool. Additional paper with demo: https://arxiv.org/abs/2103.01346 . - The [paper](https://arxiv.org/abs/2006.16743) _Learning to Format Coq Code Using Language Models_ implements a Coq code formatter. - [MathComp corpus](https://github.com/EngineeringSoftware/math-comp-corpus) is a machine learning dataset based on the [Mathematical Components](https://math-comp.github.io/) family of Coq projects, and includes several machine-readable representations of Coq code generated via SerAPI. The dataset was used to train and evaluate the Roosterize tool. - A Python interface for SerAPI can be found at [PyCoq](https://github.com/IBM/pycoq) - A direct Python interface to Coq, using `serlib` can be found at https://github.com/ejgallego/pyCoq - SerAPI is being used to improve the Coq regression proof selection tool [iCoq](https://cozy.ece.utexas.edu/icoq/), see the [paper](https://users.ece.utexas.edu/~gligoric/papers/CelikETAL17iCoq.pdf). - SerAPI is being used in additional software testing and machine learning projects; we will update this list as papers get out of embargo. ### Quick Demo (not always up to date): ```lisp $ rlwrap sertop --printer=human (Add () "Lemma addn0 n : n + 0 = n. Proof. now induction n. Qed.") > (Answer 0 Ack) > (Answer 0 (Added 2 ((fname "") (line_nb 1) (bol_pos 0) (line_nb_last 1) (bol_pos_last 0) (bp 0) (ep 26)) > NewTip)) > ... > (Answer 0 (Added 5 ... NewTip)) > (Answer 0 Completed) (Exec 5) > (Answer 1 Ack) > (Feedback ((id 5) (route 0) (contents (ProcessingIn master)))) > ... > (Feedback ((id 5) (route 0) (contents Processed))) > (Answer 1 Completed) (Query ((sid 3)) Goals) > (Answer 2 Ack) > (Answer 2 > (ObjList ((CoqGoal ((fg_goals (((name 5) (ty (App (Ind ...)))) (bg_goals ()) (shelved_goals ()) (given_up_goals ())))))) > (Answer 2 Completed) (Query ((sid 3) (pp ((pp_format PpStr)))) Goals) > (Answer 3 Ack) > (Answer 3 (ObjList ((CoqString > "\ > \n n : nat\ > \n============================\ > \nn + 0 = n")))) > (Answer 3 Completed) (Query ((sid 4)) Ast) > (Answer 4 Ack) > (Answer 4 (ObjList ((CoqAst ((((fname "") (line_nb 1) (bol_pos 0) (line_nb_last 1) > (bol_pos_last 0) (bp 34) (ep 50))) > ... > ((Tacexp > (TacAtom > (TacInductionDestruct true false > ... > (Answer 4 Completed) (pp_ex (Print ((sid 4) (pp ((pp_format PpStr)))) (CoqConstr (App (Rel 0) ((Rel 0)))))) > (Answer pp_ex Ack) > (Answer pp_ex(ObjList((CoqString"(_UNBOUND_REL_0 _UNBOUND_REL_0)")))) (Query () (Vernac "Print nat. ")) > (Answer 6 Ack) > (Feedback ((id 5) (route 0) (contents > (Message Notice () > ((Pp_box (Pp_hovbox 0) ...) > (Answer 6 (ObjList ())) > (Answer 6 Completed) (Query () (Definition nat)) > (Answer 7 Ack) > (Answer 7 (ObjList ((CoqMInd (Mutind ....))))) > (Answer 7 Completed) ``` ### Technical Report: There is a brief [technical report](https://hal-mines-paristech.archives-ouvertes.fr/hal-01384408) describing the motivation, design, and implementation of SerAPI. If you are using SerAPI in a project, please cite the technical report in any related publications: ```bibtex @techreport{GallegoArias2016SerAPI, title = {{SerAPI: Machine-Friendly, Data-Centric Serialization for Coq}}, author = {Gallego Arias, Emilio Jes{\'u}s}, url = {https://hal-mines-paristech.archives-ouvertes.fr/hal-01384408}, institution = {MINES ParisTech}, year = {2016}, month = Oct, } ``` ## Developer Information ### Technical Details SerAPI has four main components: - `serapi`, an extended version of the current IDE protocol; - `serlib`, a library providing automatic de/serialization of most Coq data structures using `ppx_conv_sexp`. This should be eventually incorporated into Coq itself. Support for `ppx_deriving_yojson` is work in progress; - `sertop`, `sertop_js`, toplevels offering implementations of the protocol; - `sercomp`, `sertok`, command-line tools providing access to key features of `serlib`. Building your own toplevels using `serlib` and `serapi` is encouraged. ### Advanced Use Cases With a bit more development effort, you can also: - Use SerAPI as an OCaml library. The low-level serialization library [`serlib/`](/serlib) and the higher-level SerAPI protocol in [`serapi/serapi_protocol.mli`](/serapi/serapi_protocol.mli) can be linked standalone. - Use SerAPI's web worker [JavaScript Worker](https://developer.mozilla.org/en-US/docs/Web/API/Web_Workers_API/Using_web_workers) from your web/node application. In this model, you communicate with SerAPI using the typical `onmessage/postMessage` worker API. Ready-to-use builds may be found at [here](https://github.com/ejgallego/jscoq-builds/tree/serapi), we provide an example REPL at: https://x80.org/rhino-hawk We would also like to provide a [Jupyter/IPython kernel](https://github.com/ejgallego/coq-serapi/issues/17). ### Developer/Users Mailing List SerAPI development is mainly discussed [on GitHub](https://github.com/ejgallego/coq-serapi) and in the [Gitter channel](https://gitter.im/coq-serapi/Lobby). You can also use the jsCoq mailing list by subscribing at: https://x80.org/cgi-bin/mailman/listinfo/jscoq The mailing list archives should also be available at the Gmane group: `gmane.science.mathematics.logic.coq.jscoq`. You can post to the list using nntp. ## Acknowledgments SerAPI has been developed at the [Centre de Recherche en Informatique](https://www.cri.ensmp.fr) of [MINES ParisTech](http://www.mines-paristech.fr/) (former École de Mines de Paris) and was partially supported by the [FEEVER](http://www.feever.fr) project. coq-serapi-8.20.0-0.20.0/VERSION000066400000000000000000000000141466734233400154360ustar00rootroot00000000000000%%VERSION%% coq-serapi-8.20.0-0.20.0/coq-serapi.opam000066400000000000000000000035141466734233400173170ustar00rootroot00000000000000opam-version: "2.0" maintainer: "e@x80.org" homepage: "https://github.com/ejgallego/coq-serapi" bug-reports: "https://github.com/ejgallego/coq-serapi/issues" dev-repo: "git+https://github.com/ejgallego/coq-serapi.git" license: "LGPL-2.1-or-later" doc: "https://ejgallego.github.io/coq-serapi/" synopsis: "Serialization library and protocol for machine interaction with the Coq proof assistant" description: """ SerAPI is a library for machine-to-machine interaction with the Coq proof assistant, with particular emphasis on applications in IDEs, code analysis tools, and machine learning. SerAPI provides automatic serialization of Coq's internal OCaml datatypes from/to JSON or S-expressions (sexps). """ authors: [ "Emilio Jesús Gallego Arias" "Karl Palmskog" "Clément Pit-Claudel" "Kaiyu Yang" ] depends: [ "dune" { >= "2.9.1" } "ocaml" { >= "4.12.0" } "coq" { >= "8.20" & < "8.21" | = "dev" } "cmdliner" { >= "1.1.0" } "ocamlfind" { >= "1.8.0" } "sexplib" { >= "v0.13.0" } "dune" { >= "2.0.1" } "cmdliner" { >= "1.1.0" } "ocamlfind" { >= "1.8.0" } "ppx_import" { >= "1.11.0" & < "2.0" } "ppx_deriving" { >= "4.2.1" } "ppx_deriving_yojson" { >= "3.4" } "sexplib" { >= "v0.13.0" & < "v0.18" } "ppx_sexp_conv" { >= "v0.13.0" & < "v0.18" } "ppx_compare" { >= "v0.13.0" & < "v0.18" } "ppx_hash" { >= "v0.13.0" & < "v0.18" } ] conflicts: [ "result" {< "1.5"} ] build: [ "dune" "build" "-p" name "-j" jobs ] run-test: [ [ "dune" "runtest" "-p" name "-j" jobs ] ] coq-serapi-8.20.0-0.20.0/coq/000077500000000000000000000000001466734233400151555ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/coq/dune000066400000000000000000000001221466734233400160260ustar00rootroot00000000000000(library (name coq) (public_name coq-serapi.coq) (libraries coq-core.vernac)) coq-serapi-8.20.0-0.20.0/coq/loader.ml000066400000000000000000000103361466734233400167600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* not_available_warn fl_pkg info; None (* Should improve *) let map_serlib fl_pkg = let supported = match fl_pkg with (* Supported by serlib *) (* directory *) | "coq-core.plugins.btauto" (* btauto *) | "coq-core.plugins.cc_core" (* cc_core *) | "coq-core.plugins.cc" (* cc *) | "coq-core.plugins.extraction" (* extraction *) | "coq-core.plugins.firstorder_core" (* firstorder_core *) | "coq-core.plugins.firstorder" (* firstorder *) | "coq-core.plugins.funind" (* funind *) | "coq-core.plugins.ltac" (* ltac *) | "coq-core.plugins.ltac2" (* ltac2 *) | "coq-core.plugins.micromega" (* micromega *) | "coq-core.plugins.micromega_core" (* micromega_core *) | "coq-core.plugins.ring" (* ring *) | "coq-core.plugins.ssreflect" (* ssreflect *) | "coq-core.plugins.ssrmatching" (* ssrmatching *) | "coq-core.plugins.number_string_notation" (* syntax *) | "coq-core.plugins.tauto" (* tauto *) | "coq-core.plugins.zify" (* zify *) -> true | _ -> not_available_warn fl_pkg ": serlib support is missing"; false in if supported then let plugin_name = String.split_on_char '.' fl_pkg |> list_last in let serlib_name = "coq-serapi.serlib." ^ plugin_name in check_package_exists serlib_name else None (* We used to be liberal here in the case a SerAPI plugin was not available. This proved to be a bad choice as Coq got confused when plugin loading failed. Par-contre, we now need to make the list in `map_serlib` open, so plugins can register whether they support serialization. I'm afraid that'll have to happen via the finlib database as we cannot load anticipatedly a plugin that may not exist. *) let safe_loader loader fl_pkg = try loader [fl_pkg] with exn -> let iexn = Exninfo.capture exn in let exn_msg = CErrors.iprint iexn in Feedback.msg_warning Pp.(str "Loading findlib plugin: " ++ str fl_pkg ++ str "failed" ++ fnl () ++ exn_msg); Exninfo.iraise iexn let default_loader pkgs : unit = Fl_dynload.load_packages ~debug:false pkgs let plugin_handler user_loader = let loader = Option.default default_loader user_loader in let safe_loader = safe_loader loader in fun fl_pkg -> let _, fl_pkg = Mltop.PluginSpec.repr fl_pkg in match map_serlib fl_pkg with | Some serlib_pkg -> safe_loader serlib_pkg | None -> safe_loader fl_pkg coq-serapi-8.20.0-0.20.0/coq/loader.mli000066400000000000000000000027451466734233400171360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit) option -> Mltop.PluginSpec.t -> unit coq-serapi-8.20.0-0.20.0/dune000066400000000000000000000000301466734233400152420ustar00rootroot00000000000000(vendored_dirs vendor) coq-serapi-8.20.0-0.20.0/dune-project000066400000000000000000000001031466734233400167070ustar00rootroot00000000000000(lang dune 2.9) (formatting (enabled_for ocaml)) (name coq-serapi) coq-serapi-8.20.0-0.20.0/notes/000077500000000000000000000000001466734233400155235ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/notes/FAQ.md000066400000000000000000000144401466734233400164570ustar00rootroot00000000000000## What is SerAPI? SerAPI is a library plus a set of command line tools aimed to improve the communication of third party tools with Coq. As of today, SerAPI has been mostly replaced by `coq-lsp`, except the `serlib` library which is actively used. ## How mature is SerAPI? SerAPI has _experimental_ status; while there are no protocol stability guarantees, we got moderate experience with it and evolution should be controlled. SerAPI have been used with success in several research projects. Protocol-breaking changes are marked in the changelog with `(!)`. Note that a likely side-effect of SerAPI being in maintenance mode is that few changes to the protocol will happen. ## Which Coq versions does SerAPI support? At the moment, Coq 8.19 is the current supported version. Older versions (Coq 8.6---8.18) work, however the protocol and feature sets do differ. ## How can I install SerAPI? The supported way is to use the OPAM package manager. The `.github/workflows/ci.yml` file contains up to date install instructions if you want to build SerAPI manually, see also the [build instructions](build.md) file. ## What serialization formats does SerAPI provide? SerAPI was built to encode Coq native data types to/from S-Expressions, a widely used data and code format pioneered by the lisp programming language. Since then, SerAPI has evolved to take advantage of other formats, and now provides experimental Python and JSON output formats too. ## What kind of S-expressions does SerAPI use? SerAPI does use Jane Street's excellent [sexplib](https://github.com/janestreet/sexplib) library print and parse S-exps; note that there is not really a S-exp standard, for more details about some differences on how quoting happens in `sexplib`, please see issues https://github.com/ejgallego/coq-serapi/issues/3 , https://github.com/ejgallego/coq-serapi/issues/8 , and https://github.com/ejgallego/coq-serapi/issues/22 . ## SerAPI hangs with inputs larger than 4096 characters: This is due to a historical limitation of the UNIX/Linux TTY API. See [#38](https://github.com/ejgallego/coq-serapi/issues/38). If you communicate with SerAPI using a **pipe** this shouldn't be a problem. Alternatively, you can use the `ReadFile` experimental command. ## I get an error "Cannot link ml-object ..." Your OCaml path is not properly setup, see [build instructions](notes/build.md) for more help. ## Can SerAPI produce `.vo` files? Yes, see `sercomp --help` ## How does SerAPI compare to TCoq [TCoq](https://github.com/ml4tp/tcoq/) provides some support for exporting Coq structures; the main differences with SerAPI is that SerAPI works against stock Coq and is maintained; it also provides a faithful, automatically generated printers. A more detailed comparison is needed, in particular TCoq does provide some hooks that insert themselves in the proof execution, it is not clear that SerAPI can provide that. For a more detailed discussion see https://github.com/ejgallego/coq-serapi/issues/109 ## Can SerAPI evaluate a document incrementally? Yes, by using Coq's capabilities to that effect. Just issue the proper `(Cancel ...)` `(Add ... ...)` sequence to simulate an update. This is limited now to prefix-only incremental evaluation. It will be improved in the future. ## Does SerAPI support asynchronous proof processing? Yes, it does. Note however that asynchronous proof processing is still in experimental status upstream. In particular, there are some issues on Windows, and `EditAt` may be inconvenient to use. We recommend not using `EditAt` and instead using the less powerful `Cancel` for now. ## Does SerAPI support Coq's command line flags: We support only a limited set of `coqtop` command line flags, in particular `-R` and `-Q` for setting library paths. Unfortunately, due to our command line parsing library, the format is slightly different. See `sertop --help` for a comprehensive list of flags. SerAPI aims to be "command line flag free", with all the options for each document passed in the document creation call, so this will be the preferred method. ## What does SerAPI expose? SerAPI exposes all core Coq datatypes. Tactics, AST, kernel terms and types are all serialized. SerAPI also provide an API to manipulate and query "Coq documents". ## How many ASTs does Coq have? That's a very interesting question! The right answer is: _countably many_! Logician jokes aside, the truth is that Coq features an _extensible_ AST. While this gives great power to plugins, it means that consumers of the AST need to design their tools to support an _open_ AST. Coq's core parsing AST is called `vernac_expr`. This type represents the so-called "Coq vernaculars". Plugins can extend the "vernacular", so you should be prepared to handle arbitrary content under the `VernacExtend` constructor. Such arbitrary content is called in Coq terminology "generic arguments". ### Interpretation and Terms After parsing, a term will undergo two elaboration phases before it will reach "kernel" form. The top-level parsing type for terms is `constr_expr`, which is then _internalized_ to a `glob_constr`. This process will perform: - Name resolution. Example `λ x : nat. x` is resolved to `λ (x: Init.nat), Var 1` [using debruijn for bound variables]. - Notation interpretation. For example, `a + b` is desugared to `Nat.add a b`. - Implicit argument resolution. For example `fst a` is desugared to `@fst _ _ a` [note the holes]. - Some desugaring of pattern-matching problems also takes place. The next step is type inference (called pretyping in Coq, as "typing" is used for the kernel-level type checking), which will turn a term in `glob_constr` form into a full-typed `Constr.t` value. `Constr.t` are the core terms manipulated by Coq's kernel and tactics. When a _generic argument_ is added to Coq's AST, we must also provide the corresponding _internalization_ and _pretyping_ functions. To that purpose, generic arguments have associated 3-levels, `raw`, `glb`, and `top` which correspond to parsing-level, internalized-level, and kernel-level. Thus, a generic argument of type `foo`, may carry 3 different OCaml types depending on the level the type is. This is used for example to define the AST of _LTAC_ tactics, where the expression `pose s := foo` with `foo` initially a `constr_expr` will undergo interpretation and inference up to a term with a fully elaborated `foo` term. coq-serapi-8.20.0-0.20.0/notes/ROADMAP.md000066400000000000000000000025251466734233400171340ustar00rootroot00000000000000### Full document parsing. - Full asynchronous `Add/Cancel` protocol. => Add a cache so users can efficiently send full documents. ### Better Locate - Implement Locate -> "file name where the object is defined". - Improve locate [EJGA: how?] - Help with complex codepaths: Load Path parsing and completion code is probably one of the most complex part of company-coq ### Completion / Naming - Improve the handling of names and environments, see `Coq.Init.Notations.instantiate` vs `instantiate`, the issue of `Nametab.shortest_qualid_of_global` is a very sensible one for IDEs Maybe we could add some options `Short`, `Full`, `Best` ? ... Or we could even serialize the naming structure and let the ide decide if we export the current open namespace. ### Benchmarking - add bench option to queries commands basically (bench (any list of serapi commands)) will return BenchData - Define timing info? Maybe this is best handled at the STM level. ### Misc - Redo Query API, make Query language a GADT. - Support regexps in queries. - Would be easy to get a list of vernacs? Things like `Print`, `Typeclasses eauto`, etc. => ppx to enumerate datatypes. Write the help command with this and also Clément suggestions about Vernac enumeration. - enable an open CoqObject tag for plugin use (see coq/coq#209 ) ? - Checkstyle support. coq-serapi-8.20.0-0.20.0/notes/announce-0.6.md000066400000000000000000000051011466734233400201510ustar00rootroot00000000000000Subject: [ANNOUNCE] jsCoq and SerAPI releases Dear Coq users and developers, we are happy to announce the releases of jsCoq 0.9.3 and SerAPI 0.6.1 for Coq 8.9. jsCoq and SerAPI are free software, please don't hesitate to report issues and contribute at: - https://github.com/ejgallego/jscoq - https://github.com/ejgallego/coq-serapi ## jsCoq 0.9: jsCoq allows interacting with Coq developments as standard-compliant HTML documents using a browser. The project aims to ease the development of interactive Coq documents and teaching material, to improve the accessibility of the platform, and to explore new user interaction possibilities. jsCoq 0.9 has been three years in the making, and it features a long list of improvements, most of them due to the incredible work of Shachar Itzhaky, who managed to stabilize the Web Worker version and provided countless usability and display improvements including "Company-Coq"-like contextual information display facilities. While there are still some minor bugs, we feel that this is the first release that seems ready for wider testing and exposure; in particular, as Coq now runs in a separate browser thread, the overall experience is much smoother than before. Keep in mind that jsCoq's primary target is introductory Coq material, thus it is expected to struggle with heavy developments. You can see some examples including the "Software Foundations" suite in the links below: - https://x80.org/rhino-coq/ - https://x80.org/rhino-coq/examples/lf/ - https://x80.org/rhino-coq/examples/plf/ See more examples and information in the project's web page https://github.com/ejgallego/jscoq, the full list of changes is at https://github.com/ejgallego/jscoq/blob/v8.9%2Bworker/CHANGES.md ## SerAPI 0.6.1 SerAPI provides an S-expression based API suitable for machine interaction with Coq. Capabilities include full round-trip serialization of Coq's AST and most internal structures, easy access to the document build and checking API, and facilities for querying Coq's environment and proof state. The 0.6.1 release brings many improvements and features on the serialization front. Thanks to the awesome efforts of Karl Palmskog and Ahmet Celik, SerAPI is now able to serialize/deserialize large Coq developments reliably, and we have improved the `sercomp` command-line tool for batch (de)serialization of Coq files. See more information and examples on the project's website https://github.com/ejgallego/coq-serapi, the full list of changes is at https://github.com/ejgallego/coq-serapi/blob/v8.9/CHANGES.md Best regards, Emilio & all contributors to these projects coq-serapi-8.20.0-0.20.0/notes/announce-0.7.0.md000066400000000000000000000023201466734233400203100ustar00rootroot00000000000000Subject: [ANNOUNCE] SerAPI 0.7.0 Dear Coq users and developers, we are happy to announce the release SerAPI 0.7.0 for Coq 8.10. SerAPI provides an S-expression based API suitable for machine interaction with Coq. Capabilities include full round-trip serialization of Coq's AST and most internal structures, easy access to the document build and checking API, and facilities for querying Coq's environment and proof state. SerAPI is developed by Emilio J. Gallego Arias, Karl Palmskog, and many other contributors. SerAPI is free software. please don't hesitate to report issues and contribute at: - https://github.com/ejgallego/coq-serapi ## SerAPI 0.7.0 The 0.7.0 release provides brings many small improvements, bugfixes, and tweaks; two highlights of the 0.7.0 release are: - it is now possible to serialize from/to `JSON` using the `Serlib` API - `sertok` command-line tool provides batch tokenization of Coq documents See more information and examples on the project's website https://github.com/ejgallego/coq-serapi, the full list of changes is at https://github.com/ejgallego/coq-serapi/blob/v8.10/CHANGES.md Items marked with `(!)` are protocol-breaking changes. Best regards, Emilio, Karl & all contributors coq-serapi-8.20.0-0.20.0/notes/async-support.md000066400000000000000000000030721466734233400206760ustar00rootroot00000000000000Notes on async support: ## Current flags for async STM support are: - `async_proofs [= APoff]`: Enable first level (CoqIDE-like) async support. ```ocaml type async_proofs = APoff | APonLazy | APon ``` This flag seems to activate the STM async mode. TODO: What does `APonLazy` do? - `async_proofs_full [= false]`: Enable second level (Coqoon-like) async support. Seems unstable for now. - `async_proofs_never_reopen_branch [= false]`: Disables "branch" editing. - `async_proofs_worker_id [= "master"]`: Maintains the identity of the particular worker. This is a flag given that the identity is set via a command line flag. - Error resilience ( coq/coq#173 ): ```ocaml let async_proofs_tac_error_resilience = ref (`Only [ "par" ; "curly" ]) let async_proofs_cmd_error_resilience = ref true ``` - Resource control flags: ```ocaml let async_proofs_n_workers = ref 1 let async_proofs_n_tacworkers = ref 2 ``` - More flags: ```ocaml let async_proofs_delegation_threshold = ref 0.03 type cache = Force let async_proofs_cache = ref None let async_proofs_private_flags = ref None let async_proofs_flags_for_workers = ref [] type priority = Low | High let async_proofs_worker_priority = ref Low type tac_error_filter = [ `None | `Only of string list | `All ] ``` ## Flags logic: On `Stm.init ()`, flags are checked to determine what mode to put the STM on. Queues will be created and workers setup. ```ocaml let async_proofs_is_worker () = !async_proofs_worker_id <> "master" let async_proofs_is_master () = !async_proofs_mode = APon && !async_proofs_worker_id = "master" ``` coq-serapi-8.20.0-0.20.0/notes/build.md000066400000000000000000000045631466734233400171540ustar00rootroot00000000000000# Building SerAPI Manually SerAPI is available for different Coq versions, with each of its branches targeting the corresponding Coq branch. The current development branch is `v8.12` targeting Coq's `v8.12` branch. Basic build instructions are below; the `.travis.yml` files should contain up-to-date information in any case. We recommend using OPAM to setup the build environment, however Théo Zimmermann has reported success in [NixOS](https://nixos.org). 0. The currently supported OCaml version is 4.07.1: ``$ opam switch 4.07.1 && eval $(opam env)``. We also assume `COQVER=v8.12`. 1. Install the needed packages: `$ opam install cmdliner sexplib dune ppx_import ppx_deriving ppx_sexp_conv yojson ppx_deriving_yojson`. 2. Download and compile Coq. We recommend: `$ git clone -b ${COQVER} https://github.com/coq/coq.git ~/external/coq-${COQVER} && cd ~/external/coq-${COQVER} && ./configure -local -native-compiler no && make -j $NJOBS`. 3. Type `make SERAPI_COQ_HOME=~/external/coq-${COQVER}` to build `sertop`. Alternatively, you can install Coq `>= 8.12` using OPAM and build against it using just `make`. The above instructions assume that you use `~/external/coq-${COQVER}` directory to place the Coq build that SerAPI needs; you can modify the `SERAPI_COQ_HOME` variable in `Makefile` to make this change permanent, or override the provided default. SerAPI does use the [Dune](https://github.com/ocaml/dune) build system, thus standard Dune considerations do apply. ## Executing built binaries A special consideration is that SerAPI does provide serialization plugins that are loaded when Coq plugins are. In particular, SerAPI does use `findlib` to manage plugins' dependencies, so you must execute `sertop` and `sercomp` using `dune exec` or with the proper `OCAMLPATH` pointing out to the right install location of Coq. If that is not properly done, the usual symptom is the error message: ``` (CoqExn "Cannot link ml-object ground_plugin.cmxs to Coq code (Fl_package_base.No_such_package(\"coq-serapi.serlib.ground_plugin\", \"\")).")) ``` When executing binaries via `dune exec`, be sure to pass any arguments after `--`, e.g., `dune exec sercomp -- --help`. ## Advanced Developer Setup SerAPI builds using Dune which supports modular builds. Starting with Coq 8.10 you can indeed compose the build of Coq and SerAPI. This is still experimental; we will provide more details soon. coq-serapi-8.20.0-0.20.0/notes/goals.md000066400000000000000000000026501466734233400171550ustar00rootroot00000000000000# Notes on goal handling: - Goals are retrieved by `Query`. It will return the whole proof object which is quite intimidating, but on the good side it opens up basically any possibility. For each goal, we've chosen to return the true internal representation of the objects, basically a `constr`. It turns out you really need access to it if you want to do some more advanced features. The return type comes from Coq and is:: ```ocaml type 'a pre_goals = { fg_goals : 'a list; bg_goals : ('a list * 'a list) list; shelved_goals : 'a list; given_up_goals : 'a list; } ``` is instantiated at this lower level with:: ```ocaml 'a = Constr.constr * Context.NamedList.Declaration.t list ``` that is, type + hypotheses, where hypotheses are:: ```ocaml Id.t list * Constr.t option * Constr.t ``` a list of names, an (optional) definition, and the type. Typical example:: ```ocaml f := map id : nat -> nat ``` - `Query` will take a family of filters operating on the representation. Some candidates are: - Filter by type of goal => This is an enumeration datatype for the fields of the record. - Filter by name of hypotheses/goal. - Filter by type/shape pattern => you provide the `constr_pattern` you want, like in search. - Filter by dependency. - *Insert your own here* As in all queries, you may chose to get the raw representation, a pretty printed one, a rich document, etc... coq-serapi-8.20.0-0.20.0/notes/protocol.md000066400000000000000000000145001466734233400177060ustar00rootroot00000000000000# Notes on a Coq Protocol for IDEs These are some notes on the JsCoq Coq Protocol, which IOVH should work for other IDEs too. ## State of the art: ### Emacs/ProofGeneral The current interface used by Emacs/ProofGeneral (and possibly other tools) is a `string -> string` based interface with a bit of extra information. This approach is fragile, PG is fully coupled to the printer and parser, and must do it own printing/parsing of Coq's output. This design choice also has the the effect to require a new Vernacular command everytime an IDE needs some functionality, see for instance coq/coq#64. A few examples of how the Vernacular situation is are: ```ocaml type showable = | ShowGoal of goal_reference | ShowGoalImplicitly of int option | ShowProof | ShowNode | ShowScript | ShowExistentials | ShowUniverses | ShowTree | ShowProofNames | ShowIntros of bool | ShowMatch of lident | ShowThesis ``` ```ocaml type printable = | PrintTables | PrintFullContext | PrintSectionContext of reference | PrintInspect of int | PrintGrammar of string | PrintLoadPath of DirPath.t option | PrintModules | PrintModule of reference | PrintModuleType of reference | PrintNamespace of DirPath.t | PrintMLLoadPath | PrintMLModules | PrintDebugGC | PrintName of reference or_by_notation | PrintGraph | PrintClasses | PrintTypeClasses | PrintInstances of reference or_by_notation | PrintLtac of reference | PrintCoercions | PrintCoercionPaths of coercion_class * coercion_class | PrintCanonicalConversions | PrintUniverses of bool * string option | PrintHint of reference or_by_notation | PrintHintGoal | PrintHintDbName of string | PrintRewriteHintDbName of string | PrintHintDb | PrintScopes | PrintScope of string | PrintVisibility of string option | PrintAbout of reference or_by_notation*int option | PrintImplicit of reference or_by_notation | PrintAssumptions of bool * bool * reference or_by_notation | PrintStrategy of reference or_by_notation option ``` Not much more can be said. ### CoqIDE CoqIDE has done a significant effort to provide a more structured API to IDEs. The main entry points for the api are documented at (`interface.ml`)[ide/interface.ml]. Unfolding the types the current API resutls: ```ocaml type handler = { add : (string * edit_id) * (state_id * verbose) -> state_id * ((unit, state_id) union * string); edit_at : state_id -> (unit, state_id * (state_id * state_id)) union; query : string * state_id -> string; goals : unit -> goals option; evars : unit -> evar list option; hints : unit -> (hint list * hint) option; status : bool -> status; search : search_flags -> string coq_object list; get_options : unit -> (option_name * option_state) list; set_options : (option_name * option_value) list -> unit mkcases : string -> string list list; about : unit -> coq_info; stop_worker : string -> unit; print_ast : string -> Xml_datatype.xml; annotate : string -> Xml_datatype.xml; handle_exn : Exninfo.iexn -> state_id * location * string; init : string option -> state_id; quit : unit -> unit; (* Retrocompatibility stuff *) interp : (raw * verbose) * string -> state_id * (string,string) Util.union; } ``` This is looking much better! Some comments about the API: - Serialization of data structures is intertwined in the API. Two level serialization happens, first from Coq objects to strings, then to XML. This results in duplication. - Synchronous/asynchronous calling convention is hidden in a different layer. - It doesn't reflect what feedback a call may produce. - It may be difficult to extend in a compatible way. - It doesn't support streaming of results. - It doesn't support per-command options. Also, how error handling happens is not very clear in general. ## Main design principles for SerAPI: We want to propose an evolution of the above API suited for use in (jsCoq)[https://github.com/ejgallego/jscoq/]. The main design mottu are: - Separate API from RPC. - Separate data serialization from API. - Favor extensibility. - Remove duplication. - Be fully asynchronous, support streaming. This last point is likely the most debatable one; however in principle any Coq operation can be quite expensive so we think it is a good approach to have the IDEs assume a full asynchronous operation. ## Identifying the main use cases: Aside from these foundational principles, we may ask us the somewhat important question, _what do IDEs need?_ Broadly speaking, IDEs perform 3 kind of operations: 1. Updating the Coq document; this includes adding/editing the document. 2. Searching/querying for objects, "select objects of kind X using criterion Y". 3. Printing/parsing objects. 4. Listening to feedback from the theorem prover. Other auxiliary operations are needed like option setting, path handling, etc... ## Identifying the communication modes. For tasks 1 and 3, it seems some synchronicity is needed. Thus, some form of RPC is needed. For 2 and 4, IDEs can react in an asynchronous way. Thus, some form of streaming is needed. ## A First Try: Let's define two layers: ### Coq Objects: This includes goals, evars, tactics, constr, etc... We use tags to ensure extensibility. Object can be generally queried, parsed, and printed. Some examples are: - tactics - options - definitions [== search] - loadpaths Plugins can add things here! ```ocaml type _ coq_object = | Constr : constr -> constr coq_object | Tactic : tactic -> tactic coq_object | Hint : tactic -> tactic coq_object etc... ``` ### The STM: Control STM manipulation primitives are: + add + edit + commit + worker_ctrl/ctrl (quit, init) And we have a set of specific answers: + exn? ### Queries: Search - Allow `Query` to return a diff. - Allow `Query` to return objects in different forms: uid refs, printed, raw - Allow `Query` to filter objects. The filter library should be strongly typed. ```ocaml type _ query = | U : int -> int query | B : int -> string query | C : unit -> unit query ``` ### Printing/Parsing: Display + printer: `object -> string` + parser: `string -> object` coq-serapi-8.20.0-0.20.0/notes/ser-control-protocol.md000066400000000000000000000055651466734233400221660ustar00rootroot00000000000000# SerAPI control protocol This document defines the SerAPI control protocol. It is based on the Coq XML protocol plus many discussions with developers. The goal of the protocol is to allow IDEs to be as stateless as possible. To this extent, the IDE should generally react to relevant user input by sending the proper Coq command and forgetting about it. Coq is allowed to notify about the results of these commands (if any) arbitrary long. Arbitrary commands can be queued, and Coq must interact properly on all use cases. ## Document Building / Maintenance A document is build by adding/cancelling nodes. Each node corresponds to a Coq sentence. `nid` ### Commands - `Add(after, nid, text)`: Adds a new node `nid` to the document after node `after`. It will result in a parsing error or in a confirmation of proper parsing. - `Cancel(nid)`: Informs Coq the node `nid` is no longer valid. It will invariably succeed. - `Observe(nid)`: "Observes" (executes) until node `nid`. It may produce much feedback, including errors. ### Responses/Feedback - `Added(nid, loc)`: Informs the UI that node `nid` was successfully parsed. - `Errored(nid, msg)`: Informs the UI that node `nid` fatally failed. It must be added again _XXX: should we require cancellation of a failed node? keep in mind that there exist non-fatal errors that indeed must be cancelled_ - `Cancelled(nid_list)`: Informs the UI that the `nid_list` nodes are no longer valid. - `Message(nid, msg)`: Informs of non-fatal errors, warnings, debug information. - Rest of feedback: processed, ready, etc... ### Whole Document Parsing `Add(after, nid, text)`: Can also have a whole document parsing. In this case, the returned `nid` will be appended a number starting with `0`. Thus, one add can generate many `Added`. How to solve the problem of segmenting a user-provided id? Maybe Coq should reply a segmented answer? (Segmented id-k ((id1 pos1) (id2 pos2) .... (idn posn))) But what would happen with the typical "event before the segmented happened"? Maybe we want to store a "segmentation" map. ### Interrupting 1. The IDE must send an interrupt signal to sertop. 1. The IDE must process all the pending feedback until getting the Break message. 1. The IDE must then cancel non-desired states. ### Error Handling - Is an errored state cancelled? - Is it a bug in Coq to produce an exception but not an err msg? In fact, Coq sending cancel is the same than coq sending error? The key point is that what should the IDE do? It cannot add after a truly errored state. So in this sense, I would cancel all of them, however before cancelling we'd like to signal it as errored. Ummm. That is indeed not clear. ### Use cases / Examples - UI edit after add: The user sends a sentence, to immediate edit it. In this case, the IDE sends `Added(nid)` + `Cancel(nid)`, no need to wait. ## Acknowledgments Clément Pit--Claudel, Enrico Tassi coq-serapi-8.20.0-0.20.0/serapi/000077500000000000000000000000001466734233400156565ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serapi/dune000066400000000000000000000002521466734233400165330ustar00rootroot00000000000000(library (name serapi) (public_name coq-serapi.serapi_v8_14) (synopsis "Serialization Protocol for Coq") (libraries coq-core.stm coq-core.plugins.ltac sexplib base)) coq-serapi-8.20.0-0.20.0/serapi/serapi_assumptions.ml000066400000000000000000000073701466734233400221470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ((id,typ) :: v, a, o, tr) | Axiom (axiom, l) -> (v, (axiom,typ,l) :: a, o, tr) | Opaque kn -> (v, a, (kn,typ) :: o, tr) | Transparent kn -> (v, a, o, (kn,typ) :: tr) in let (vars, axioms, opaque, trans) = ContextObjectMap.fold fold ctxmap ([], [], [], []) in { predicative = not (Environ.is_impredicative_set env) ; type_in_type = Environ.type_in_type env ; vars ; axioms ; opaque ; trans } let print env sigma { predicative; type_in_type; vars; axioms; opaque; trans } = let pr_engament e = match e with | false -> Pp.str "Set is Impredicative" | true -> Pp.str "Set is Predicative" in let pr_var env sigma (id, typ) = Pp.(seq [Names.Id.print id; str " : "; Printer.pr_ltype_env env sigma typ ]) in let pr_constant env sigma (cst, typ) = Pp.(seq [Names.Constant.print cst; str " : "; Printer.pr_ltype_env env sigma typ ]) in let pr_axiom env sigma (ax, typ, lctx) = let pr_ax env sigma typ a = let open Printer in match a with | Constant kn -> Pp.(seq [Names.Constant.print kn; str " : "; Printer.pr_ltype_env env sigma typ]) | Positive m -> Pp.(seq [Printer.pr_inductive env (m,0); str "is positive."]) | Guarded gr -> Pp.(seq [Printer.pr_global gr; str "is positive."]) | TypeInType gr -> Pp.(seq [Printer.pr_global gr; spc (); strbrk "relies on an unsafe hierarchy."]) | UIP m -> Pp.(seq [Printer.pr_inductive env (m,0); spc (); strbrk "relies on UIP."]) in Pp.(seq [ pr_ax env sigma typ ax ; prlist (fun (lbl, ctx, ty) -> str " used in " ++ Names.Label.print lbl ++ str " to prove:" ++ Printer.pr_ltype_env Environ.(push_rel_context ctx env) sigma ty) lctx ]) in Pp.(v 0 (prlist_with_sep (fun _ -> cut ()) (fun x -> x) [ if type_in_type then str "type_in_type is on" else mt () ; pr_engament predicative ; hov 1 (prlist (pr_var env sigma) vars) ; hov 1 (prlist (pr_constant env sigma) opaque) ; hov 1 (prlist (pr_constant env sigma) trans) ; hov 1 (prlist (pr_axiom env sigma) axioms) ])) coq-serapi-8.20.0-0.20.0/serapi/serapi_assumptions.mli000066400000000000000000000031531466734233400223130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Constr.t Printer.ContextObjectMap.t -> t val print : Environ.env -> Evd.evar_map -> t -> Pp.t coq-serapi-8.20.0-0.20.0/serapi/serapi_doc.ml000066400000000000000000000040761466734233400203270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (* let pfs = Proof_global.get_all_proof_names pstate in *) let pfs = [] in if not CList.(is_empty pfs) then let msg = let open Pp in seq [ str "There are pending proofs: " ; pfs |> List.rev |> prlist_with_sep pr_comma Names.Id.print; str "."] in CErrors.user_err msg ) pstate let save_vo ~doc ?ldir ~pstate ~in_file () = let _doc = Stm.join ~doc in check_pending_proofs ~pstate; let ldir = match ldir with | None -> Stm.get_ldir ~doc (* EJGA: When in interactive mode, the above won't work due to a STM bug, we thus allow SerAPI clients to override it *) | Some ldir -> ldir in let out_vo = Filename.(remove_extension in_file) ^ ".vo" in let todo_proofs = Library.ProofsTodoNone in let () = Library.save_library_to todo_proofs ~output_native_objects:false ldir out_vo in () coq-serapi-8.20.0-0.20.0/serapi/serapi_doc.mli000066400000000000000000000026101466734233400204700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val save_vo : doc:Stm.doc -> ?ldir:Names.DirPath.t -> pstate:Vernacstate.LemmaStack.t option -> in_file:string -> unit -> unit coq-serapi-8.20.0-0.20.0/serapi/serapi_goals.ml000066400000000000000000000105041466734233400206600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (Names.Id.t list * 'pc option * 'pc) = let open CDC in function | LocalAssum(idl, tm) -> (List.map Context.binder_name idl, None, ppx tm) | LocalDef(idl,tdef,tm) -> (List.map Context.binder_name idl, Some (ppx tdef), ppx tm) (** gets a hypothesis *) let get_hyp (ppx : EConstr.t -> 'pc) (_sigma : Evd.evar_map) (hdecl : cdcl) : (Names.Id.t list * 'pc option * 'pc) = to_tuple ppx hdecl (** gets the constr associated to the type of the current goal *) let get_goal_type (ppx : Constr.t -> 'pc) (env : Environ.env) (sigma : Evd.evar_map) (g : Evar.t) : _ = let EvarInfo evi = Evd.find sigma g in let concl = match Evd.evar_body evi with | Evd.Evar_empty -> Evd.evar_concl evi | Evd.Evar_defined body -> Retyping.get_type_of env sigma body in ppx @@ EConstr.to_constr ~abort_on_undefined_evars:false sigma concl let build_info sigma g = { evar = g ; name = Evd.evar_ident g sigma } (** Generic processor *) let process_goal_gen ppx sigma g : 'a reified_goal = (* XXX This looks cumbersome *) let env = Global.env () in let EvarInfo evi = Evd.find sigma g in let env = Evd.evar_filtered_env env evi in (* why is compaction neccesary... ? [eg for better display] *) let ctx = Termops.compact_named_context sigma (EConstr.named_context env) in let ppx = ppx env sigma in let eppx c = ppx (EConstr.Unsafe.to_constr c) in let hyp = List.map (get_hyp eppx sigma) ctx in let info = build_info sigma g in { info; ty = get_goal_type ppx env sigma g; hyp } let if_not_empty (pp : Pp.t) = if Pp.(repr pp = Ppcmd_empty) then None else Some pp let get_goals_gen (ppx : Environ.env -> Evd.evar_map -> Constr.t -> 'a) ~doc sid : 'a reified_goal ser_goals option = match Stm.state_of_id ~doc sid with | Valid (Some { Vernacstate.interp = { lemmas = Some lemmas ; _ }; _} ) -> let proof = Vernacstate.LemmaStack.with_top lemmas ~f:(fun pstate -> Declare.Proof.get pstate) in let { Proof.goals; stack; sigma; _ } = Proof.data proof in let ppx = List.map (process_goal_gen ppx sigma) in Some { goals = ppx goals ; stack = List.map (fun (g1,g2) -> ppx g1, ppx g2) stack ; bullet = if_not_empty @@ Proof_bullet.suggest proof ; shelf = Evd.shelf sigma |> ppx ; given_up = Evd.given_up sigma |> Evar.Set.elements |> ppx } | Expired | Error _ | Valid _ -> None let get_goals = get_goals_gen (fun _ _ x -> x) let get_egoals = get_goals_gen (fun env evd ec -> Constrextern.extern_constr ~inctx:true env evd EConstr.(of_constr ec)) coq-serapi-8.20.0-0.20.0/serapi/serapi_goals.mli000066400000000000000000000041671466734233400210410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Evd.evar_map -> Constr.t -> 'a) -> Evd.evar_map -> Evar.t -> 'a reified_goal (* Ready to make into a GADT *) val get_goals_gen : (Environ.env -> Evd.evar_map -> Constr.t -> 'a) -> doc:Stm.doc -> Stateid.t -> 'a reified_goal ser_goals option val get_goals : doc:Stm.doc -> Stateid.t -> Constr.t reified_goal ser_goals option val get_egoals : doc:Stm.doc -> Stateid.t -> Constrexpr.constr_expr reified_goal ser_goals option coq-serapi-8.20.0-0.20.0/serapi/serapi_paths.ml000066400000000000000000000055331466734233400207000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* mk_vo ~has_ml:true ~coq_path:default_root ~implicit:false ~dir ~absolute:true) Envars.coqpath (******************************************************************************) (* Generate a module name given a file *) (******************************************************************************) let dirpath_of_file f = let ldir0 = try let lp = Loadpath.find_load_path (Filename.dirname f) in Loadpath.logical lp with Not_found -> Libnames.default_root_prefix in let file = Filename.chop_extension (Filename.basename f) in let id = Names.Id.of_string file in Libnames.add_dirpath_suffix ldir0 id coq-serapi-8.20.0-0.20.0/serapi/serapi_paths.mli000066400000000000000000000026061466734233400210470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* coq_path:string -> string list * Loadpath.vo_path list (* Generate a module name given a file, to be removed in 8.10 *) val dirpath_of_file : string -> Names.DirPath.t coq-serapi-8.20.0-0.20.0/serapi/serapi_pp.ml000066400000000000000000000101751466734233400201760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a -> unit (************************************************************************) (* Print Helpers *) (************************************************************************) let pp_str fmt str = fprintf fmt "%s" str let pp_opt pp fmt opt = match opt with | None -> () | Some x -> fprintf fmt "%a" pp x let rec pp_list ?sep pp fmt l = match l with [] -> fprintf fmt "" | csx :: [] -> fprintf fmt "@[%a@]" pp csx | csx :: csl -> fprintf fmt "@[%a@]%a@;%a" pp csx (pp_opt pp_str) sep (pp_list ?sep pp) csl (************************************************************************) (* Statid *) (************************************************************************) let pp_stateid fmt id = fprintf fmt "%d" (Stateid.to_int id) (************************************************************************) (* Feedback *) (************************************************************************) let pp_feedback_content fmt fb = let open Feedback in match fb with (* STM mandatory data (must be displayed) *) | Processed -> fprintf fmt "Processed" | Incomplete -> fprintf fmt "Incomplete" | Complete -> fprintf fmt "Complete" (* STM optional data *) | ProcessingIn s -> fprintf fmt "ProcessingIn: %s" s | InProgress d -> fprintf fmt "InProgress: %d" d | WorkerStatus(w1, w2) -> fprintf fmt "WorkerStatus: %s, %s" w1 w2 (* Generally useful metadata *) | AddedAxiom -> fprintf fmt "AddedAxiom" | GlobRef (_loc, s1, s2, s3, s4) -> fprintf fmt "GlobRef: %s,%s,%s,%s" s1 s2 s3 s4 | GlobDef (_loc, s1, s2, s3) -> fprintf fmt "GlobDef: %s,%s,%s" s1 s2 s3 | FileDependency (os, s) -> fprintf fmt "FileDep: %a, %s" (pp_opt pp_str) os s | FileLoaded (s1, s2) -> fprintf fmt "FileLoaded: %s, %s" s1 s2 (* Extra metadata *) | Custom(_loc, msg, _xml) -> fprintf fmt "Custom: %s" msg (* Old generic messages *) | Message(_lvl, _loc, m) -> fprintf fmt "Msg: @[%a@]" Pp.pp_with m let pp_feedback fmt (fb : Feedback.feedback) = let open Feedback in fprintf fmt "feedback for [%a]: @[%a@]" pp_stateid fb.span_id pp_feedback_content fb.Feedback.contents (************************************************************************) (* Xml *) (************************************************************************) let pp_attr fmt (xtag, att) = fprintf fmt "%s = %s" xtag att let rec pp_xml fmt (xml : Xml_datatype.xml) = match xml with | Xml_datatype.Element (tag, att, more) -> fprintf fmt "@[<%s @[%a@]>@,%a@,@]" tag (pp_list pp_attr) att (pp_list pp_xml) more tag | Xml_datatype.PCData str -> fprintf fmt "%s" str coq-serapi-8.20.0-0.20.0/serapi/serapi_pp.mli000066400000000000000000000032771466734233400203540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a -> unit val pp_str : string pp val pp_opt : 'a pp -> ('a option) pp val pp_list : ?sep:string -> 'a pp -> ('a list) pp val pp_stateid : Stateid.t pp val pp_feedback : Feedback.feedback pp val pp_xml : Xml_datatype.xml pp coq-serapi-8.20.0-0.20.0/serapi/serapi_protocol.ml000066400000000000000000001121251466734233400214160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None | x :: _ -> Some x let mem l e = List.mem e l (* let sub s ~pos ~len = String.sub s pos len *) let value x ~default = Option.default default x let value_map x ~default ~f = Option.cata f default x let is_prefix = Base.String.is_prefix let split_while = Base.List.split_while (* Custom tokenizer *) let rec stream_tok n_tok acc lstr = let e = Gramlib.LStream.next (Pcoq.get_keyword_state()) lstr in let loc = Gramlib.LStream.get_loc n_tok lstr in let l_tok = CAst.make ~loc e in if Tok.(equal e EOI) then List.rev (l_tok::acc) else stream_tok (n_tok+1) (l_tok::acc) lstr end (******************************************************************************) (* SerAPI protocol & interpreter. *) (******************************************************************************) exception NoSuchState of Stateid.t exception CannotSaveVo (******************************************************************************) (* Auxiliary Definitions *) (******************************************************************************) (******************************************************************************) (* Basic Protocol Objects *) (******************************************************************************) (* We'd like to use GADTs here, but we'd need to pack them somehow to * support serialization both ways, see Jérémie's Dimino comment here: * * https://github.com/janestreet/ppx_sexp_conv/issues/8 * * We need a type of tags + some packing, then: * * type _ object = * | Option : option object * | Search : string list object * | Goals : goals object * [@@deriving sexp] *) (* XXX: Use a module here to have Coq.String etc...? *) type coq_object = | CoqString of string | CoqSList of string list | CoqPp of Pp.t (* | CoqRichpp of Richpp.richpp *) | CoqLoc of Loc.t | CoqTok of Tok.t CAst.t list | CoqDP of Names.DirPath.t | CoqAst of Vernacexpr.vernac_control | CoqOption of Goptions.option_name * Goptions.option_state | CoqConstr of Constr.constr | CoqEConstr of EConstr.t | CoqExpr of Constrexpr.constr_expr | CoqMInd of Names.MutInd.t * Declarations.mutual_inductive_body | CoqEnv of Environ.env | CoqTactic of Names.KerName.t * Tacenv.ltac_entry | CoqLtac of Tacexpr.raw_tactic_expr | CoqGenArg of Genarg.raw_generic_argument | CoqQualId of Libnames.qualid | CoqGlobRef of Names.GlobRef.t | CoqGlobRefExt of Globnames.extended_global_reference | CoqImplicit of Impargs.implicits_list | CoqProfData of Profile_tactic.treenode | CoqNotation of Constrexpr.notation | CoqUnparsing of Ppextend.notation_printing_rules * Notation_gram.notation_grammar | CoqGoal of Constr.t Serapi_goals.reified_goal Serapi_goals.ser_goals | CoqExtGoal of Constrexpr.constr_expr Serapi_goals.reified_goal Serapi_goals.ser_goals | CoqProof of EConstr.constr list | CoqAssumptions of Serapi_assumptions.t | CoqComments of ((int * int) * string) list list | CoqLibObjects of { library_segment : Summary.Interp.frozen Lib.library_segment; path_prefix : Nametab.object_prefix } (** Meta-logical Objects in Coq's library / module system *) (******************************************************************************) (* Printing Sub-Protocol *) (******************************************************************************) (* Basically every function here should be an straightforward call to * Coq's printing. Coq bug if that is not the case. *) let pp_goal_gen pr_c { Serapi_goals.ty ; hyp ; _ } = let open Pp in let pr_idl idl = prlist_with_sep (fun () -> str ", ") Names.Id.print idl in let pr_lconstr_opt c = str " := " ++ pr_c c in let pr_hdef = Option.cata pr_lconstr_opt (mt ()) in let pr_hyp (idl, hdef, htyp) = pr_idl idl ++ pr_hdef hdef ++ (str " : ") ++ pr_c htyp in pr_vertical_list pr_hyp hyp ++ str "============================\n" ++ (* (let pr_lconstr t = *) (* let (sigma, env) = Pfedit.get_current_context () in *) (* Ppconstr.Richpp.pr_lconstr_expr (Constrextern.extern_constr false env sigma t) *) (* in *) pr_c ty let pp_opt_value (s : Goptions.option_value) = match s with | Goptions.BoolValue b -> Pp.bool b | Goptions.IntValue i -> Pp.pr_opt Pp.int i | Goptions.StringValue s -> Pp.str s | Goptions.StringOptValue s -> Pp.pr_opt Pp.str s let pp_opt n s = let open Pp in str (String.concat "." n) ++ str " := " ++ pp_opt_value s.Goptions.opt_value (* XXX fixme 8.15 *) let _pp_explicitation = let open Constrexpr in function | ExplByPos i -> Pp.(int i ++ str "None") | ExplByName iname -> Names.Id.print iname let pp_implicit : Impargs.implicit_status -> Pp.t = function | None -> Pp.str "!" | Some _ -> Pp.str "!" (* pp_explicitation expl *) (* let pp_richpp xml = let open Xml_datatype in let buf = Buffer.create 1024 in let rec print = function | PCData s -> Buffer.add_string buf s | Element (_, _, cs) -> List.iter print cs in let () = print xml in Buffer.contents buf *) let gen_pp_obj env sigma (obj : coq_object) : Pp.t = match obj with | CoqString s -> Pp.str s | CoqSList s -> Pp.(pr_sequence str) s | CoqPp s -> s (* | CoqRichpp s -> Pp.str (pp_richpp s) *) | CoqLoc _loc -> Pp.mt () | CoqTok toks -> Pp.pr_sequence (fun {CAst.v = tok;_} -> Pp.str (Tok.(extract_string false tok))) toks | CoqDP dp -> Names.DirPath.print dp | CoqAst v -> Ppvernac.pr_vernac v | CoqMInd(m,mind) -> Printmod.pr_mutual_inductive_body env m mind None | CoqOption (n,s) -> pp_opt n s | CoqConstr c -> Printer.pr_lconstr_env env sigma c | CoqEConstr c -> Printer.pr_leconstr_env env sigma c | CoqExpr e -> Ppconstr.pr_lconstr_expr env sigma e | CoqEnv _env -> Pp.str "Cannot pretty print environments" | CoqTactic(kn,_) -> Names.KerName.print kn | CoqLtac t -> Pptactic.pr_raw_tactic env sigma t | CoqGenArg ga -> let open Genprint in begin match generic_raw_print ga with | PrinterBasic pp -> pp env sigma (* XXX: Fixme, the level here is random *) | PrinterNeedsLevel pp -> pp.printer env sigma Constrexpr.LevelSome end (* Fixme *) | CoqGoal g -> Pp.prlist_with_sep Pp.fnl (pp_goal_gen Printer.(pr_lconstr_env env sigma)) g.Serapi_goals.goals | CoqExtGoal g -> Pp.prlist_with_sep Pp.fnl (pp_goal_gen Ppconstr.(pr_lconstr_expr env sigma)) g.Serapi_goals.goals | CoqProof _ -> Pp.str "FIXME UPSTREAM, provide pr_proof" | CoqProfData _pf -> Pp.str "FIXME UPSTREAM, provide pr_prof_results" | CoqQualId qid -> Pp.str (Libnames.string_of_qualid qid) | CoqGlobRef gr -> Printer.pr_global gr | CoqGlobRefExt gr -> (match gr with | Globnames.TrueGlobal gr -> Printer.pr_global gr | Globnames.Abbrev kn -> Names.KerName.print kn ) | CoqImplicit(_,l) -> Pp.pr_sequence pp_implicit l | CoqNotation ntn -> Pp.str (snd ntn) | CoqUnparsing _ -> Pp.str "FIXME Unparsing" | CoqAssumptions a -> Serapi_assumptions.print env sigma a (* | CoqPhyLoc(_,_,s)-> pr (Pp.str s) *) (* | CoqGoal (_,g,_) -> pr (Ppconstr.pr_lconstr_expr g) *) (* | CoqGlob g -> pr (Printer.pr_glob_constr g) *) | CoqComments _ -> Pp.str "FIXME comments" | CoqLibObjects _ -> Pp.str "FIXME libobjects" let str_pp_obj env sigma fmt (obj : coq_object) = Format.fprintf fmt "%a" Pp.pp_with (gen_pp_obj env sigma obj) (** Print output format *) type print_format = | PpSer (** Output in serialized format [usually sexp but could be extended in the future] *) | PpStr (** Output a string with a human-friendly representation *) | PpTex (** Output a TeX expression *) | PpCoq (** Output a TeX expression *) (* | PpRichpp *) (* register printer *) type format_opt = { pp_format : print_format [@default PpSer]; pp_depth : int [@default 0]; pp_elide : string [@default "..."]; pp_margin : int [@default 72]; } type print_opt = { sid : Stateid.t [@default Stm.get_current_state ~doc:Stm.(get_doc 0)]; (** [sid] denotes the {e sentence id} we are querying over, essential information as goals for example will vary. *) pp : format_opt [@default { pp_format = PpSer; pp_depth = 0; pp_elide = "..."; pp_margin = 72 } ]; (** Printing format of the query, this can be used to select the type of the answer, as for example to show goals in human-form. *) } let pp_tex (_obj : coq_object) = "" (* let tex_sexp c = let open Format in pp_set_margin str_formatter 300; pp_set_max_indent str_formatter 300; Stexp.pp_sexp_to_tex str_formatter c; flush_str_formatter () in let open List in let open Ser_constr in let open Ser_constrexpr in let open Ser_vernacexpr in let open Serapi_goals in match obj with | CoqConstr cst -> sexp_of_constr cst |> tex_sexp | CoqGoal gl -> let cst = (hd gl.goals).ty in sexp_of_constr cst |> tex_sexp | CoqExtGoal gl -> let cst = (hd gl.goals).ty in sexp_of_constr_expr cst |> tex_sexp | CoqAst(_,ast) -> sexp_of_vernac_control ast |> tex_sexp | _ -> "not supported" *) let obj_print env sigma pr_opt obj = let open Format in match pr_opt.pp_format with | PpSer -> obj | PpCoq -> CoqPp (gen_pp_obj env sigma obj) | PpTex -> CoqString (pp_tex obj) (* | PpRichpp -> CoqRichpp (Richpp.richpp_of_pp pr_opt.pp_margin (gen_pp_obj obj)) *) | PpStr -> let mb = pp_get_max_boxes str_formatter () in let et = pp_get_ellipsis_text str_formatter () in let mg = pp_get_margin str_formatter () in pp_set_max_boxes str_formatter pr_opt.pp_depth; pp_set_ellipsis_text str_formatter pr_opt.pp_elide; pp_set_margin str_formatter pr_opt.pp_margin; fprintf str_formatter "@[%a@]" (str_pp_obj env sigma) obj; let str_obj = CoqString (flush_str_formatter ()) in pp_set_max_boxes str_formatter mb; pp_set_ellipsis_text str_formatter et; pp_set_margin str_formatter mg; str_obj (******************************************************************************) (* Answer Types *) (******************************************************************************) module ExnInfo = struct type t = { loc : Loc.t option ; stm_ids : (Stateid.t * Stateid.t) option ; backtrace : Printexc.raw_backtrace ; exn : exn ; pp : Pp.t ; str : string } end type answer_kind = Ack | Completed | Added of Stateid.t * Loc.t * Stm.add_focus | Canceled of Stateid.t list | ObjList of coq_object list | CoqExn of ExnInfo.t (******************************************************************************) (* Query Sub-Protocol *) (******************************************************************************) (** Max number of results to return, 0 will return a summary *) (* type query_limit = int option *) (** Filtering predicates *) type query_pred = | Prefix of string (* Filter by type *) (* Filter by module *) let prefix_pred (prefix : string) (obj : coq_object) : bool = match obj with | CoqString s -> Extra.is_prefix s ~prefix | CoqSList _ -> true (* XXX *) | CoqLoc _ -> true | CoqTok _ -> true | CoqPp _ -> true (* | CoqRichpp _ -> true *) | CoqAst _ -> true | CoqDP _ -> true | CoqOption (n,_) -> Extra.is_prefix (String.concat "." n) ~prefix | CoqConstr _ -> true | CoqEConstr _ -> true | CoqExpr _ -> true | CoqMInd _ -> true | CoqEnv _ -> true | CoqTactic(kn,_) -> Extra.is_prefix (Names.KerName.to_string kn) ~prefix | CoqLtac _ -> true | CoqGenArg _ -> true (* | CoqPhyLoc _ -> true *) | CoqQualId _ -> true | CoqGlobRef _ -> true | CoqGlobRefExt _ -> true | CoqProfData _ -> true | CoqImplicit _ -> true | CoqGoal _ -> true | CoqNotation _ -> true | CoqUnparsing _ -> true | CoqExtGoal _ -> true | CoqProof _ -> true | CoqAssumptions _-> true | CoqComments _ -> true | CoqLibObjects _ -> true let gen_pred (p : query_pred) (obj : coq_object) : bool = match p with | Prefix s -> prefix_pred s obj type query_opt = { preds : query_pred list [@sexp.list]; limit : int option [@sexp.option]; sid : Stateid.t [@default Stm.get_current_state()]; pp : format_opt [@default { pp_format = PpSer; pp_depth = 0; pp_elide = "..."; pp_margin = 72 } ]; (* Legacy/Deprecated *) route : Feedback.route_id [@default 0]; } (** XXX: This should be in sync with the object tag! *) type query_cmd = | Option (* *) | Search (* Search vernacular, we only support prefix by name *) | Goals (* Return goals [TODO: Add filtering/limiting options] *) | EGoals (* Return goals [TODO: Add filtering/limiting options] *) | Ast (* Return ast *) | TypeOf of string | Names of string (* XXX Move to prefix *) | Tactics of string (* XXX Print LTAC signatures (with prefix) *) | Locate of string (* XXX Print LTAC signatures (with prefix) *) | Implicits of string (* XXX Print LTAC signatures (with prefix) *) | Unparsing of string (* XXX *) | Definition of string | LogicalPath of string | PNotations (* XXX *) | ProfileData | Proof (* Return the proof object *) | Vernac of string (* [legacy] Execute arbitrary Coq command in an isolated state. *) | Env (* Return the current global enviroment *) | Assumptions of string (* Return the assumptions of given identifier *) | Complete of string | Comments (** Get all comments of a document *) | Objects (** Get Coq meta-logical module objects *) module QueryUtil = struct let _query_names prefix = let acc = ref [] in let env = Global.env () in let sigma = Evd.from_env env in Search.generic_search env sigma (fun gr _kind _env _sigma _typ -> (* Not happy with this at ALL: String of qualid is OK, but shortest_qualid_of_global is an unacceptable round-trip. I don't really see other option than to maintain a prefix-specific table on the Coq side capturing all the possible aliases. *) let name = Libnames.string_of_qualid (Nametab.shortest_qualid_of_global Names.Id.Set.empty gr) in if Extra.is_prefix name ~prefix then acc := name :: !acc ); [CoqSList !acc] let query_names_locate prefix = let all_gr = Nametab.locate_all @@ Libnames.qualid_of_ident (Names.Id.of_string prefix) in List.map (fun x -> CoqGlobRef x) all_gr (* From @ppedrot *) (* XXX: We need to put this into a plugin, as ltac is now a plugin in 8.7. *) let query_tactics prefix = let open Names in let prefix_long kn = Extra.is_prefix (KerName.to_string kn) ~prefix in let prefix_best kn = try Extra.is_prefix (Libnames.string_of_qualid (Tacenv.shortest_qualid_of_tactic kn)) ~prefix with Not_found -> (* Debug code, It is weird that shortest_qualid_of_tactic returns a Not_found... :S *) (* Format.eprintf "%s has no short name@\n%!" (KerName.to_string kn); *) false in let tpred kn _ = prefix_long kn || prefix_best kn in KNmap.bindings @@ KNmap.filter tpred @@ Tacenv.ltac_entries () [@@warning "-44"] (* let map (kn, entry) = *) (* let qid = *) (* try Some (Nametab.shortest_qualid_of_tactic kn) *) (* with Not_found -> None *) (* in *) (* match qid with *) (* | None -> None *) (* | Some qid -> Some (qid, entry.Tacenv.tac_body) *) (* in *) (* List.map map entries [] *) let query_unparsing (nt : Constrexpr.notation) : Ppextend.notation_printing_rules * Notation_gram.notation_grammar = Ppextend.find_notation_printing_rule None nt, Notgram_ops.grammar_of_notation nt let query_pnotations () = Notgram_ops.get_defined_notations () let locate id = let open Names in let open Libnames in let open Globnames in (* From prettyp.ml *) let qid = qualid_of_string id in let expand = function | TrueGlobal ref -> Nametab.shortest_qualid_of_global Id.Set.empty ref | Abbrev kn -> Nametab.shortest_qualid_of_abbreviation Id.Set.empty kn in List.map expand (Nametab.locate_extended_all qid) let implicits id = let open Names in let open Libnames in try let ref = Nametab.locate (qualid_of_ident (Id.of_string id)) in Impargs.implicits_of_global ref with Not_found -> [] (* Copied from Coq. XXX *) let type_of_constant cb = cb.Declarations.const_type (* Definition of an inductive *) let info_of_ind env (sp, _) = [CoqMInd (sp, Environ.lookup_mind sp env)], [] let info_of_const env cr = let cdef = Environ.lookup_constant cr env in let cb = Environ.lookup_constant cr env in Option.cata (fun (cb,_univs,_uctx) -> [CoqConstr cb] ) [] (Global.body_of_constant_body (Library.indirect_accessor[@warning "-3"]) cb), [CoqConstr(type_of_constant cdef)] let info_of_var env vr = let vdef = Environ.lookup_named vr env in Option.cata (fun cb -> [CoqConstr cb] ) [] (Context.Named.Declaration.get_value vdef), [CoqConstr(Context.Named.Declaration.get_type vdef)] (* XXX: Some work to do wrt Global.type_of_global_unsafe *) let info_of_constructor env cr = (* let cdef = Global.lookup_pinductive (cn, cu) in *) let (ctype, _uctx) = Typeops.type_of_global_in_context env (Names.GlobRef.ConstructRef cr) in [],[CoqConstr ctype] (* Queries a generic definition, in the style of the `Print` vernacular *) (* definition type *) let info_of_id env id : coq_object list * coq_object list = (* parse string to a qualified name *) let qid = Libnames.qualid_of_string id in (* try locate the kind of object the name refers to *) try let lid = Nametab.locate qid in (* dispatch based on type *) let open Names.GlobRef in match lid with | VarRef vr -> info_of_var env vr | ConstRef cr -> info_of_const env cr | IndRef ir -> info_of_ind env ir | ConstructRef cr -> info_of_constructor env cr with _ -> [],[] let assumptions env id = let qid = Libnames.qualid_of_string id in let smart_global r = let gr = Nametab.locate r in Dumpglob.add_glob ?loc:r.loc gr; gr in let gr = smart_global qid in (* Assumptions doesn't care about the universes *) let cstr, _ = UnivGen.fresh_global_instance env gr in let st = Conv_oracle.get_transp_state (Environ.oracle env) in let nassums = Assumptions.assumptions (Library.indirect_accessor[@warning "-3"]) st ~add_opaque:true ~add_transparent:true gr cstr in Serapi_assumptions.build env nassums (* This should be moved Coq upstream *) let _comments = ref [] let add_comments pa = let comments = Pcoq.Parsable.comments pa |> List.rev in _comments := comments :: !_comments let libobjects () = let library_segment = Lib.contents () in let path_prefix = Lib.prefix () in CoqLibObjects { library_segment; path_prefix } let get_proof ~pstate = match pstate with | Some pstate -> let pterms = Declare.Proof.get pstate |> Proof.partial_proof in List.map (fun x -> CoqEConstr x) pterms | None -> [] end let obj_query ~doc ~pstate ~env (opt : query_opt) (cmd : query_cmd) : coq_object list = match cmd with | Option -> let table = Goptions.get_tables () in let opts = Goptions.OptionMap.bindings table in List.map (fun (n,s) -> CoqOption(n,s)) opts | Goals -> Option.cata (fun g -> [CoqGoal g ]) [] @@ Serapi_goals.get_goals ~doc opt.sid | EGoals -> Option.cata (fun g -> [CoqExtGoal g]) [] @@ Serapi_goals.get_egoals ~doc opt.sid | Ast -> Option.cata (fun last -> [CoqAst last]) [] @@ Stm.get_ast ~doc opt.sid | Names prefix -> QueryUtil.query_names_locate prefix | Tactics prefix -> List.map (fun (i,t) -> CoqTactic(i,t)) @@ QueryUtil.query_tactics prefix | Locate id -> List.map (fun qid -> CoqQualId qid) @@ QueryUtil.locate id | Implicits id -> List.map (fun ii -> CoqImplicit ii ) @@ QueryUtil.implicits id | ProfileData -> [CoqProfData (Profile_tactic.get_local_profiling_results ())] | Proof -> QueryUtil.get_proof ~pstate | Unparsing ntn -> (* Unfortunately this will produce an anomaly if the notation is not found... * To keep protocol promises we need to special wrap it. *) begin try let up, gr = QueryUtil.query_unparsing (Constrexpr.InConstrEntry,ntn) in [CoqUnparsing(up,gr)] with _exn -> [] end | LogicalPath f -> [CoqDP (Serapi_paths.dirpath_of_file f)] | PNotations -> List.map (fun s -> CoqNotation s) @@ QueryUtil.query_pnotations () | Definition id -> fst (QueryUtil.info_of_id env id) | TypeOf id -> snd (QueryUtil.info_of_id env id) | Search -> [CoqString "Not Implemented"] (* XXX: should set printing options in all queries *) | Vernac q -> let pa = Pcoq.Parsable.make (Gramlib.Stream.of_string q) in Stm.query ~doc ~at:opt.sid ~route:opt.route pa; [] (* XXX: Should set the proper sid state *) | Env -> [CoqEnv env] | Assumptions id -> [CoqAssumptions QueryUtil.(assumptions env id)] | Complete prefix -> List.map (fun x -> CoqGlobRefExt x) (Nametab.completion_canditates (Libnames.qualid_of_string prefix)) | Comments -> [CoqComments (List.rev !QueryUtil._comments)] | Objects -> [QueryUtil.libobjects ()] let obj_filter preds objs = List.(fold_left (fun obj p -> filter (gen_pred p) obj) objs preds) (* XXX: OCaml! .... *) let rec take n l = if n = 0 then [] else match l with | [] -> [] | x :: xs -> x :: take (n-1) xs let obj_limit limit objs = match limit with | None -> objs | Some n -> take n objs (* XXX: Need to protect queries... sad *) let doc_id = ref 0 (* XXX: Needs to take into account possibly local proof state *) let proof_state_of_st m = match m with | Stm.Valid (Some { Vernacstate.interp = { lemmas; _ }; _} ) -> lemmas | _ -> None let parsing_state_of_st m = match m with | Stm.Valid (Some { Vernacstate.synterp; _} ) -> Some (Vernacstate.Synterp.parsing synterp) | _ -> None let context_of_st m = match m with | Stm.Valid (Some { Vernacstate.interp = { lemmas = Some pstate; _ } ; _} ) -> Vernacstate.LemmaStack.with_top pstate ~f:Declare.Proof.get_current_context | _ -> let env = Global.env () in Evd.from_env env, env let exec_query opt cmd = let doc = Stm.get_doc !doc_id in let st = Stm.state_of_id ~doc opt.sid in let sigma, env = context_of_st st in let pstate = proof_state_of_st st in let pstate = Option.map (Vernacstate.LemmaStack.with_top ~f:(fun p -> p)) pstate in let res = obj_query ~doc ~pstate ~env opt cmd in (* XXX: Filter should move to query once we have GADT *) let res = obj_filter opt.preds res in let res = obj_limit opt.limit res in List.map ((obj_print env sigma) opt.pp) res (******************************************************************************) (* Control Sub-Protocol *) (******************************************************************************) (* coq_exn info *) let coq_exn_info exn = let backtrace = Printexc.get_raw_backtrace () in let exn, info = Exninfo.capture exn in let pp = CErrors.iprint (exn, info) in CoqExn { loc = Loc.get_loc info ; stm_ids = Stateid.get info ; backtrace ; exn ; pp ; str = Pp.string_of_ppcmds pp } (* Simple protection for Coq-generated exceptions *) let coq_protect st e = try e () @ [Completed], st with exn -> [coq_exn_info exn; Completed], st (* let msg = str msg ++ fnl () ++ CErrors.print ~info e in *) (* Richpp.richpp_of_pp msg *) type parse_entry = Vernac | Constr (** parse [ontop] of the given sentence with entry [entry] *) type parse_opt = { ontop : Stateid.t option [@sexp.option] ; entry : parse_entry [@default Vernac] } type add_opts = { lim : int option [@sexp.option]; ontop : Stateid.t option [@sexp.option]; newtip : Stateid.t option [@sexp.option]; verb : bool [@default false]; } module ControlUtil = struct type doc = Stateid.t list let cur_doc : doc ref = ref [Stateid.of_int 1] let pp_doc fmt l = let open Serapi_pp in Format.fprintf fmt "@[%a@]" (pp_list ~sep:" " pp_stateid) l let _dump_doc () = Format.eprintf "%a@\n%!" pp_doc !cur_doc let parse_expr ~doc ~ontop str = let ontop = Extra.value ontop ~default:(Stm.get_current_state ~doc) in parsing_state_of_st (Stm.state_of_id ~doc ontop) |> Option.map (fun pstate -> let entry = Pcoq.Constr.lconstr in let pa = Pcoq.Parsable.make (Gramlib.Stream.of_string str) in Pcoq.unfreeze pstate; Pcoq.Entry.parse entry pa) let parse_sentence ~doc ~ontop sent = let ontop = Extra.value ontop ~default:(Stm.get_current_state ~doc) in let pa = Pcoq.Parsable.make (Gramlib.Stream.of_string sent) in let entry = Pvernac.main_entry in Stm.parse_sentence ~doc ontop ~entry pa let parse_entry ~doc ~(opt : parse_opt) str = let ontop = opt.ontop in match opt.entry with | Vernac -> Option.map (fun x -> [CoqAst x]) (parse_sentence ~doc ~ontop str) | Constr -> Option.map (fun x -> [CoqExpr x]) (parse_expr ~doc ~ontop str) exception End_of_input let add_sentences ~doc opts sent = let pa = Pcoq.Parsable.make (Gramlib.Stream.of_string sent) in let i = ref 1 in let acc = ref [] in let stt = ref (Extra.value opts.ontop ~default:(Stm.get_current_state ~doc)) in let doc = ref doc in let check_lim i = Extra.value_map opts.lim ~default:true ~f:(fun lim -> i <= lim) in try while check_lim !i do (* XXX: We check that the ontop state is actually in the * document to avoid an Anomaly exception. *) if not (List.mem !stt !cur_doc) then raise (NoSuchState !stt); let east = (* Flags.beautify is needed so comments are stored by the lexer... *) let parse_res = Flags.with_option Flags.beautify (Stm.parse_sentence ~doc:!doc !stt ~entry:Pvernac.main_entry) pa in match parse_res with | Some ast -> ast | None -> raise End_of_input in Flags.beautify := false; (* XXX: Must like refine the API *) let eloc = Option.get (east.CAst.loc) in let n_doc, n_st, foc = Stm.add ~doc:!doc ?newtip:opts.newtip ~ontop:!stt opts.verb east in doc := n_doc; cur_doc := n_st :: !cur_doc; acc := (Added (n_st, eloc, foc)) :: !acc; stt := n_st; incr i done; !doc, pa, List.rev !acc with | End_of_input -> !doc, pa, List.rev !acc | exn -> !doc, pa, List.rev (coq_exn_info exn :: !acc) (* We follow a suggestion by Clément to report sentence invalidation in a more modular way: When we issue the cancel command, we will look for the cancelled part *) let cancel_interval st (foc : Stm.focus) = let open Serapi_pp in let fmt = Format.err_formatter in Format.fprintf fmt "Cancel interval: [%a -- %a]" pp_stateid st pp_stateid foc.Stm.stop; [] (* eprintf "%d" foc.stop *) (* failwith "SeqAPI FIXME, focus not yet supported" *) (* We recover the list of states to cancel plus the first valid one. The main invariant is that: - The state has to belong to the list. - The we cancel states that are newer *) let invalid_range can_st ~incl:include_st = let pred st = if include_st then Stateid.newer_than st can_st || Stateid.equal st can_st else Stateid.newer_than st can_st in if Extra.mem !cur_doc can_st then Extra.split_while !cur_doc ~f:pred else [], !cur_doc let cancel_sentence ~doc can_st = (* dump_doc (); *) let c_ran, k_ran = invalid_range can_st ~incl:true in let prev_st = Extra.value (Extra.hd_opt k_ran) ~default:Stateid.initial in match Stm.edit_at ~doc prev_st with | doc, NewTip -> cur_doc := k_ran; doc, [Canceled c_ran] (* - [tip] is the new document tip. - [st] -- [stop] is dropped. - [stop] -- [tip] has been kept. - [start] is where the editing zone starts - [add] happen on top of [id]. *) | doc, Focus foc -> doc, cancel_interval can_st foc end (******************************************************************************) (* Init / new document *) (******************************************************************************) type newdoc_opts = { top_name : Coqargs.top (** name of the top-level module of the new document *) ; ml_load_path : string list option [@sexp.option] (** Initial ML loadpath *) ; vo_load_path : Loadpath.vo_path list option [@sexp.option] (** Initial LoadPath for the document *) (* [XXX: Use the coq_pkg record?] *) ; require_libs : Coqargs.require_injection list option [@sexp.option] (** Libraries to load in the initial document state *) } (** Save options, Coq must save a module `Foo` to a concrete module path determined by -R / -Q options , so we don't have a lot of choice here. *) type save_opts = { prefix_output_dir : string option [@sexp.option] (** prefix a directory to the saved vo file. *) ; sid : Stateid.t (** sid of the point to save the document *) } (******************************************************************************) (* Help *) (******************************************************************************) (* Prints help to stderr. TODO, we should use a ppx to automatically generate the description of the protocol. *) let serproto_help () = let open Format in eprintf "%s%!" ("Coq SerAPI -- Protocol documentation is still incomplete, the main commands are: \n\n" ^ " (Add add_opt \"gallina code\") -- Add new sentences to the current document \n" ^ " (Cancel sid_list) -- Cancel sentences in the current document \n" ^ " (Exec sid) -- Check sentence `sid` \n" ^ " (Query query_opt query_cmd) -- Query information about a sentence / global data \n" ^ " (Print print_opt coq_object) -- Print object with options \n" ^ "\nSee sertop_protocol.mli for more details.\n\n") (******************************************************************************) (* State *) (******************************************************************************) module State = struct type t = { in_file : string option ; ldir : Names.DirPath.t option } let make ?in_file ?ldir () = { in_file; ldir } end (******************************************************************************) (* Top-Level Commands *) (******************************************************************************) type cmd = | NewDoc of newdoc_opts | SaveDoc of save_opts | Add of add_opts * string | Cancel of Stateid.t list | Exec of Stateid.t | Query of query_opt * query_cmd | Print of print_opt * coq_object | Parse of parse_opt * string (* Full document checking *) | Join | Finish (*******************************************************************) (* Non-supported commands, only for convenience. *) | ReadFile of string | Tokenize of string (*******************************************************************) (* Administrativia *) | Noop | Help (*******************************************************************) let exec_cmd (st : State.t) (cmd : cmd) : answer_kind list * State.t = let doc = Stm.get_doc !doc_id in coq_protect st @@ fun () -> match cmd with | NewDoc opts -> let stm_options = Stm.AsyncOpts.default_opts in let require_libs = Option.default [{Coqargs.lib="Coq.Init.Prelude"; prefix=None; export=Some Lib.Export;}] opts.require_libs in Stm.init_process stm_options; let ndoc = { Stm.doc_type = Stm.(Interactive opts.top_name) ; injections = List.map (fun x -> Coqargs.RequireInjection x) require_libs } in (* This got broken upstream :S *) (* doc_id := fst Stm.(new_doc ndoc); [] *) let _ = Stm.new_doc ndoc in doc_id := 0; [] | SaveDoc opts -> begin match st.in_file with | None -> raise CannotSaveVo | Some in_file -> let in_file = Option.cata (fun prefix -> Filename.concat prefix in_file) in_file opts.prefix_output_dir in let _doc = Stm.observe ~doc opts.sid in let pst = Stm.state_of_id ~doc opts.sid in let pstate = proof_state_of_st pst in Serapi_doc.save_vo ~doc ~pstate ~in_file ?ldir:st.ldir (); [] end | Add (opt, s) -> let _doc, pa, res = ControlUtil.add_sentences ~doc opt s in QueryUtil.add_comments pa; res | Cancel stms -> List.concat @@ List.map (fun x -> snd @@ ControlUtil.(cancel_sentence ~doc x)) stms | Exec st -> ignore(Stm.observe ~doc st); [] | Query (opt, qry) -> [ObjList (exec_query opt qry)] | Print(opts, obj) -> let st = Stm.state_of_id ~doc opts.sid in let sigma, env = context_of_st st in [ObjList [obj_print env sigma opts.pp obj]] | Parse(opt,s) -> ControlUtil.(parse_entry ~doc ~opt s) |> Option.cata (fun objs -> [ObjList objs]) [] | Join -> ignore(Stm.join ~doc); [] | Finish -> ignore(Stm.finish ~doc); [] (* *) | ReadFile f -> ( let inc = open_in f in try let faddopts = { lim = None; ontop = None; newtip = None; verb = false; } in let fsize = in_channel_length inc in let fcontent = really_input_string inc fsize in let _doc, pa, res = ControlUtil.add_sentences ~doc faddopts fcontent in QueryUtil.add_comments pa; res with _ -> close_in inc; [] ) | Tokenize input -> let st = CLexer.Lexer.State.get () in begin try let istr = Gramlib.Stream.of_string input in let lex = CLexer.Lexer.tok_func istr in CLexer.Lexer.State.set st; let objs = Extra.stream_tok 0 [] lex in [ObjList [CoqTok objs]] with exn -> CLexer.Lexer.State.set st; raise exn end | Help -> serproto_help (); [] | Noop -> [] type cmd_tag = string type tagged_cmd = cmd_tag * cmd type feedback_content = | Processed | Incomplete | Complete | ProcessingIn of string | InProgress of int | WorkerStatus of string * string | AddedAxiom | FileDependency of string option * string | FileLoaded of string * string | Message of { level: Feedback.level ; loc : Loc.t option ; pp : Pp.t ; str: string } type feedback = { doc_id : Feedback.doc_id ; span_id : Stateid.t ; route : Feedback.route_id ; contents : feedback_content } type answer = | Answer of cmd_tag * answer_kind | Feedback of feedback coq-serapi-8.20.0-0.20.0/serapi/serapi_protocol.mli000066400000000000000000000620061466734233400215710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Evd.evar_map -> coq_object -> Pp.t (******************************************************************************) (* Parsing Sub-Protocol *) (******************************************************************************) (* no public interface *) (******************************************************************************) (* Query Sub-Protocol *) (******************************************************************************) (** {3 Query Sub-Protocol } *) (** Predicates on the queries. This is at the moment mostly a token functionality *) type query_pred = | Prefix of string (** Filter named objects based on the given prefix *) (** Query options, note the default values that help interactive use, however in mechanized use we do not recommend skipping any field *) type query_opt = { preds : query_pred list [@sexp.list]; (** List of predicates on queries, mostly a placeholder, will allow to add filtering conditions in the future *) limit : int option [@sexp.option]; (** Limit the number of results, should evolve into an API with resume functionality, maybe we adopt LSP conventions here *) sid : Stateid.t [@default Stm.get_current_state ~doc:Stm.(get_doc 0)]; (** [sid] denotes the {e sentence id} we are querying over, essential information as goals for example will vary. *) pp : format_opt [@default { pp_format = PpSer; pp_depth = 0; pp_elide = "..."; pp_margin = 72 } ]; (** Printing format of the query, this can be used to select the type of the answer, as for example to show goals in human-form. *) route : Feedback.route_id [@default 0]; (** Legacy/Deprecated STM query method *) } (** Query commands are mostly a tag and some arguments determining the result type. {b Important} Note that [Query] won't force execution of a particular state, thus for example if you do [(Query ((sid 3)) Goals)] and the sentence [3] wasn't evaluated, then the query will return zero answers. We would ideally evolve towards a true query language, likley having [query_cmd] and [coq_object] be typed such that query : 'a query -> 'a coq_object. *) type query_cmd = | Option (** List of options Coq knows about *) | Search (** Query version of the [Search] command *) | Goals (* Return goals [TODO: Add filtering/limiting options] *) (** Current goals, in kernel form *) | EGoals (* Return goals [TODO: Add filtering/limiting options] *) (** Current goals, in AST form *) | Ast (* Return ast *) (** Ast for the current sentence *) | TypeOf of string (* XXX Unimplemented *) (** Type of an expression (unimplemented?) *) | Names of string (* argument is prefix -> XXX Move to use the prefix predicate *) (** [(Names prefix)] will return the list of identifiers Coq knows that start with [prefix] *) | Tactics of string (* argument is prefix -> XXX Move to use the prefix predicate *) (** [(Tactcis prefix)] will return the list of tactics Coq knows that start with [prefix] *) | Locate of string (* argument is prefix -> XXX Move to use the prefix predicate *) (** Query version of the [Locate] commands *) | Implicits of string (* XXX Print LTAC signatures (with prefix) *) (** Return information of implicits for a given constant *) | Unparsing of string (* XXX *) (** Return internal information for a given notation *) | Definition of string (** Return the definition for a given global *) | LogicalPath of string (** Returns Coq's "logical path" for a given file *) | PNotations (* XXX *) (** Return a list of notations *) | ProfileData (** Return LTAC profile data, if any *) | Proof (** Return the proof object [low-level] *) | Vernac of string (** Execute an arbitrary Coq command in an isolated state. *) | Env (** Return the current enviroment *) | Assumptions of string (** Return the assumptions of a given global *) | Complete of string (** Naïve but efficient prefix-based completion of identifiers *) | Comments (** Get all comments of a document *) | Objects (** Get Coq meta-logical module objects *) module QueryUtil : sig val info_of_id : Environ.env -> string -> coq_object list * coq_object list end (******************************************************************************) (* Control Sub-Protocol *) (******************************************************************************) (** {3 Control Sub-Protocol } *) (** {4 Adding a new sentence } *) type parse_entry = Vernac | Constr (** parse [ontop] of the given sentence with entry [entry] *) type parse_opt = { ontop : Stateid.t option [@sexp.option] ; entry : parse_entry [@default Vernac] } (** [Add] will take a string and parse all the sentences on it, until an error of the end is found. Options for [Add] are: *) type add_opts = { lim : int option [@sexp.option]; (** Parse [lim] sentences at most ([None] == no limit) *) ontop : Stateid.t option [@sexp.option]; (** parse [ontop] of the given sentence *) newtip : Stateid.t option [@sexp.option]; (** Make [newtip] the new sentence id, very useful to avoid synchronous operations *) verb : bool [@default false]; (** [verb] internal Coq parameter, be verbose on parsing *) } (******************************************************************************) (* Init / new document *) (******************************************************************************) (** {4 Creating a new document } {b experimental} *) type newdoc_opts = { top_name : Coqargs.top (** name of the top-level module of the new document *) ; ml_load_path : string list option [@sexp.option] (** Initial ML loadpath *) ; vo_load_path : Loadpath.vo_path list option [@sexp.option] (** Initial LoadPath for the document *) (* [XXX: Use the coq_pkg record?] *) ; require_libs : Coqargs.require_injection list option [@sexp.option] (** Libraries to load in the initial document state *) } (** Save options, Coq must save a module `Foo` to a concrete module path determined by -R / -Q options , so we don't have a lot of choice here. *) type save_opts = { prefix_output_dir : string option [@sexp.option] (** prefix a directory to the saved vo file. *) ; sid : Stateid.t [@default Stm.get_current_state ~doc:Stm.(get_doc 0)] (** sid of the point to save the document *) } (******************************************************************************) (* Help *) (******************************************************************************) (* no public interface *) (******************************************************************************) (* Top-Level Commands *) (******************************************************************************) (** {3 Top Level Protocol } The top level protocol is the main input command to SerAPI, we detail each of the commands below. The main interaction loop is as: 1. submit tagged command [(tag (Cmd args))] 2. receive tagged ack [(Answer tag Ack)] 3. receive tagged results, usually [(Answer tag (ObjList ...)] or [(Answer tag (CoqExn ...)] 4. receive tagged completion event [(Answer tag Completed)] The [Ack] and [Completed] events are always produced, and provide a kind of "bracking" for command execution. *) (** Each top level command will produce an answers, see below for answer description. *) type cmd = | NewDoc of newdoc_opts (** Create a new document, experimental, only usable when [--no_init] was used. *) | SaveDoc of save_opts (** Save the .vo file corresponding to the current document, note that proofs must be closed etc... in order for this to succeed. *) | Add of add_opts * string (** Add a set of sentences to the current document *) | Cancel of Stateid.t list (** Remove a set of sentences from the current document *) | Exec of Stateid.t (** Execute a particular sentence *) | Query of query_opt * query_cmd (** Query a Coq document *) | Print of print_opt * coq_object (** Print some object *) | Parse of parse_opt * string (** Parse *) | Join (** Be sure that a document is consistent *) | Finish (** Internal *) (*******************************************************************) (* Non-supported commands, only for convenience. *) | ReadFile of string | Tokenize of string (*******************************************************************) (* Administrativia *) | Noop | Help (*******************************************************************) (******************************************************************************) (* Answer Types *) (******************************************************************************) (** raised when referring to a [Stateid.t] unknown to SerAPI *) exception NoSuchState of Stateid.t (** raised when trying to save a module without a corresponding [--topfile] *) exception CannotSaveVo module ExnInfo : sig type t = { loc : Loc.t option ; stm_ids : (Stateid.t * Stateid.t) option ; backtrace : Printexc.raw_backtrace ; exn : exn ; pp : Pp.t ; str : string } end type answer_kind = | Ack (** The command was received, Coq is processing it. *) | Completed (** The command was completed. *) | Added of Stateid.t * Loc.t * Stm.add_focus (** A sentence was added, with corresponding sentence id and location. *) | Canceled of Stateid.t list (** A set of sentences are not valid anymore. *) | ObjList of coq_object list (** Set of objects, usually the answer to a query *) | CoqExn of ExnInfo.t (** The command produced an error, optionally at a document location *) (** {3 State of the evaluator} *) module State : sig type t (** Create a state and possibly initialize Coq with an input_file *) val make : ?in_file:string -> ?ldir:Names.DirPath.t -> unit -> t end (** {3 Entry points to the DSL evaluator} *) (** [exec_cmd cmd] execute SerAPI command *) val exec_cmd : State.t -> cmd -> answer_kind list * State.t (** Each command and answer are tagged by a user-provided identifier *) type cmd_tag = string type tagged_cmd = cmd_tag * cmd (** We introduce our own feedback type to overcome some limitations of Coq's Feedback, for now we only modify the Message data *) type feedback_content = | Processed | Incomplete | Complete | ProcessingIn of string | InProgress of int | WorkerStatus of string * string | AddedAxiom | FileDependency of string option * string | FileLoaded of string * string | Message of { level: Feedback.level ; loc : Loc.t option ; pp : Pp.t ; str: string } type feedback = { doc_id : Feedback.doc_id ; span_id : Stateid.t ; route : Feedback.route_id ; contents : feedback_content } (** General answers of the protocol can be responses to commands, or Coq messages *) type answer = | Answer of cmd_tag * answer_kind (** The answer is comming from a user-issued command *) | Feedback of feedback (** Output produced by Coq (asynchronously) *) coq-serapi-8.20.0-0.20.0/serlib_8_20/000077500000000000000000000000001466734233400164035ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/.ocamlformat000066400000000000000000000000101466734233400206770ustar00rootroot00000000000000disable coq-serapi-8.20.0-0.20.0/serlib_8_20/README.md000066400000000000000000000121201466734233400176560ustar00rootroot00000000000000## Serlib README Welcome to `coq-serlib` README. `coq-serlib` is a library that declares missing serialization functions (from/to JSON, sexp), comparison, and hash functions for most Coq datatypes, allowing users to serialize full ASTs faithfully for example, and many other interesting use cases. `coq-serlib` also includes support for [Coq's extensible syntax]() and plugins. ### Builtins and Configuration `serlib` provides some builtins and configuration values in the `Serlib_base` and `Serlib_init` modules. ### Serializing regular Coq types The standard recipe is to use a combination of `ppx_import` and several ppx-based "derivers" to make `serlib` generate the corresponding serializers. The pattern for a Coq module `Foo` exporting the datatype `bar` and their constructors is: 1. create a new OCaml module named `ser_foo.ml` 2. get the corresponding serializers for existing types in scope, this is unusually done in two steps: - serializers for OCaml Stdlib: ```ocaml open Ppx_hash_lib.Std.Hash.Builtin open Ppx_compare_lib.Builtin open Sexplib.Std ``` - serializers for types that `Foo.bar` depends on, for example: ```ocaml module Names = Ser_names module EConstr = Ser_eConstr ... ``` 3. implement the serializers for your type. Add to `ser_foo.ml`: ```ocaml type bar = [%import: Foo.bar] [@@deriving sexp,yojson,hash,compare] ``` Additionally, you can add an `.mli` file, with the same contents as above, but in this case, `[@@deriving ...]` will generate the right interface declarations. If `Foo.bar` has no public constructors, `Obj.magic` will be needed. `serlib` provides helpers for this, see below. ### Serializing opaque and private types `serlib` uses `ppx_import` to retrieve the original type definitions from Coq; when these are not available, we provide some helpers in the `SerType` module. Current helpers are: - `Biject`: use when it is convenient to provide an isomorphic type to the one that is "opaque". - `Pierce`: use when it is not possible to access the type, you really want to use a copy + `Obj.magic` - `Opaque`: when you want to declare the type as non-serializable **note**: use of `Obj.magic` is now prohibited, all the type piercings need to use the `Pierce` functor. ### Serializing GADTS Unfortunately, it is not possible to easily serialize GADTS. For now, we use a very ugly workaround: we basically copy the original Coq datatype, in non-GADT version, then we pierce the type as their representation is isomorphic. We will use an example from https://github.com/coq/coq/pull/17667#issuecomment-1714473449 : ```ocaml type _ gen_pattern = GPat : Genarg.glob_generic_argument -> [ `uninstantiated ] gen_pattern ``` In this case, we could indeed derive a serialization function (try `[@@deriving of_sexp]` for example), however full serialization is harder, so we may need to provide an alternative data-type: ```ocaml module GenPatternRep : SerType.Pierceable1 = struct type 'a t = 'a Pattern.gen_pattern type _ _t = GPat of Genarg.glob_generic_argument [@@deriving sexp,yojson,hash,compare] end module GenPatternSer = SerType.Pierce1(GenPatternRep) type 'a gen_pattern = GenPatternSer.t [@@deriving sexp,yojson,hash,compare] ``` and here you go! The main problem with this approach is that it requires a manual check for each use of `Pierce` and each Coq version. Fortunately the numbers of `Pierce`'s so far have been very low. ### Pre-release checks Due to the above, when updating SerAPI for a new release to OPAM, we must check that the definitions we are piercing are up to date. I perform this check with Emacs + Merlin for OCaml: - I do `vc-git-grep` for `Pierce(` and `Pierce1(` - For each use, I use merlin to jump to the original type - I compare update these types That's painful, but takes like 10 minutes, so for now it is doable a couple of times a year. To illustrate, these are the current occurrences to check: ``` serlib/plugins/ltac2/ser_tac2expr.ml:module T2E = Serlib.SerType.Pierce(T2ESpec) serlib/plugins/ltac2/ser_tac2expr.ml:module GT2E = Serlib.SerType.Pierce(GT2ESpec) serlib/ser_cooking.ml:module B_ = SerType.Pierce(CIP) serlib/ser_environ.ml: include SerType.Pierce(PierceSpec) serlib/ser_float64.ml:include SerType.Pierce(PierceSpec) serlib/ser_impargs.ml:module B_ = SerType.Pierce(ISCPierceSpec) serlib/ser_names.ml:include SerType.Pierce(MBIdBij) serlib/ser_names.ml: include SerType.Pierce(PierceSpec) serlib/ser_names.ml: include SerType.Pierce(PierceSpec) serlib/ser_numTok.ml: include SerType.Pierce(PierceSpec) serlib/ser_opaqueproof.ml:module B_ = SerType.Pierce(OP) serlib/ser_opaqueproof.ml:module C_ = SerType.Pierce(OTSpec) serlib/ser_rtree.ml:include SerType.Pierce1(RTreePierce) serlib/ser_sList.ml:include SerType.Pierce1(SL) serlib/ser_safe_typing.ml:module B_ = SerType.Pierce(PC) serlib/ser_sorts.ml:include SerType.Pierce(PierceSpec) serlib/ser_stateid.ml:include SerType.Pierce(SId) serlib/ser_univ.ml: module PierceImp = SerType.Pierce(PierceSpec) serlib/ser_univ.ml: include SerType.Pierce(PierceSpec) serlib/ser_univ.ml: include SerType.Pierce(ACPierceDef) serlib/ser_vmemitcodes.ml:module B = SerType.Pierce(PierceToPatch) ``` coq-serapi-8.20.0-0.20.0/serlib_8_20/dune000066400000000000000000000003671466734233400172670ustar00rootroot00000000000000(library (name serlib) (public_name coq-serapi.serlib) (synopsis "AST utility Library for Coq") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare ppx_deriving_yojson)) (libraries coq-core.vernac sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/000077500000000000000000000000001466734233400200645ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/btauto/000077500000000000000000000000001466734233400213625ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/btauto/dune000066400000000000000000000004441466734233400222420ustar00rootroot00000000000000(library (name serlib_btauto) (public_name coq-serapi.serlib.btauto) (synopsis "Serialization Library for Coq BTauto Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.btauto serlib sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/cc/000077500000000000000000000000001466734233400204515ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/cc/dune000066400000000000000000000004341466734233400213300ustar00rootroot00000000000000(library (name serlib_cc) (public_name coq-serapi.serlib.cc) (synopsis "Serialization Library for Coq Congruence Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.cc serlib sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/extraction/000077500000000000000000000000001466734233400222445ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/extraction/dune000066400000000000000000000004511466734233400231220ustar00rootroot00000000000000(library (name serlib_extraction) (public_name coq-serapi.serlib.extraction) (synopsis "Serialization Library for Coq Fundind Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.extraction serlib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/extraction/ser_g_extraction.ml000066400000000000000000000034531466734233400261420ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) open Serlib open Sexplib.Conv open Ppx_compare_lib.Builtin open Ppx_hash_lib.Std.Hash.Builtin module Names = Ser_names module Extraction_plugin = struct module G_extraction = Extraction_plugin.G_extraction module Table = struct type int_or_id = [%import: Extraction_plugin.Table.int_or_id] [@@deriving sexp,yojson,hash,compare] type lang = [%import: Extraction_plugin.Table.lang] [@@deriving sexp,yojson,hash,compare] end end module WitII = struct type t = Extraction_plugin.Table.int_or_id [@@deriving sexp,yojson,hash,compare] end let ser_wit_int_or_id = let module M = Ser_genarg.GSV(WitII) in M.genser module WitL = struct type t = Extraction_plugin.Table.lang [@@deriving sexp,yojson,hash,compare] end let ser_wit_language = let module M = Ser_genarg.GSV(WitL) in M.genser module WitMN = struct type t = string [@@deriving sexp,yojson,hash,compare] end let ser_wit_mlname = let module M = Ser_genarg.GSV(WitMN) in M.genser let register () = Ser_genarg.register_genser Extraction_plugin.G_extraction.wit_int_or_id ser_wit_int_or_id; Ser_genarg.register_genser Extraction_plugin.G_extraction.wit_language ser_wit_language; Ser_genarg.register_genser Extraction_plugin.G_extraction.wit_mlname ser_wit_mlname; () let _ = register () coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/firstorder/000077500000000000000000000000001466734233400222475ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/firstorder/dune000066400000000000000000000004211466734233400231220ustar00rootroot00000000000000(library (name serlib_firstorder) (public_name coq-serapi.serlib.firstorder) (synopsis "Serialization Library for Coq Firstorder Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare)) (libraries coq-core.plugins.firstorder serlib sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/firstorder/ser_g_ground.ml000066400000000000000000000031321466734233400252550ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) open Serlib open Sexplib.Conv open Ppx_compare_lib.Builtin open Ppx_hash_lib.Std.Hash.Builtin module Loc = Ser_loc module Names = Ser_names module Libnames = Ser_libnames module Locus = Ser_locus (* module Globnames = Ser_globnames *) type h1 = Libnames.qualid list [@@deriving sexp, hash, compare] type h2 = Names.GlobRef.t Loc.located Locus.or_var list [@@deriving sexp, hash, compare] type h3 = Names.GlobRef.t list [@@deriving sexp,hash,compare] let ser_wit_firstorder_using : (Libnames.qualid list, Names.GlobRef.t Loc.located Locus.or_var list, Names.GlobRef.t list) Ser_genarg.gen_ser = Ser_genarg.{ raw_ser = sexp_of_h1 ; raw_des = h1_of_sexp ; raw_hash = hash_fold_h1 ; raw_compare = compare_h1 ; glb_ser = sexp_of_h2 ; glb_des = h2_of_sexp ; glb_hash = hash_fold_h2 ; glb_compare = compare_h2 ; top_ser = sexp_of_h3 ; top_des = h3_of_sexp ; top_hash = hash_fold_h3 ; top_compare = compare_h3 } let register () = Ser_genarg.register_genser Firstorder_plugin.G_ground.wit_firstorder_using ser_wit_firstorder_using; () let _ = register () coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/funind/000077500000000000000000000000001466734233400213475ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/funind/dune000066400000000000000000000004161466734233400222260ustar00rootroot00000000000000(library (name serlib_funind) (public_name coq-serapi.serlib.funind) (synopsis "Serialization Library for Coq Fundind Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare)) (libraries coq-core.plugins.funind serlib serlib_ltac sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/funind/ser_g_indfun.ml000066400000000000000000000065561466734233400243570ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) open Serlib open Ppx_compare_lib.Builtin open Ppx_hash_lib.Std.Hash.Builtin open Sexplib.Conv module CAst = Ser_cAst module Names = Ser_names module Sorts = Ser_sorts module Libnames = Ser_libnames module Constrexpr = Ser_constrexpr module Tactypes = Ser_tactypes module Genintern = Ser_genintern module EConstr = Ser_eConstr module Tacexpr = Serlib_ltac.Ser_tacexpr module A1 = struct type h1 = Constrexpr.constr_expr Tactypes.intro_pattern_expr CAst.t option [@@deriving sexp,hash,compare] type h2 = Genintern.glob_constr_and_expr Tactypes.intro_pattern_expr CAst.t option [@@deriving sexp,hash,compare] type h3 = Tacexpr.intro_pattern option [@@deriving sexp,hash,compare] end let ser_wit_with_names = let open A1 in Ser_genarg.{ raw_ser = sexp_of_h1 ; raw_des = h1_of_sexp ; raw_hash = hash_fold_h1 ; raw_compare = compare_h1 ; glb_ser = sexp_of_h2 ; glb_des = h2_of_sexp ; glb_hash = hash_fold_h2 ; glb_compare = compare_h2 ; top_ser = sexp_of_h3 ; top_des = h3_of_sexp ; top_hash = hash_fold_h3 ; top_compare = compare_h3 } module WitFI = struct type raw = Constrexpr.constr_expr Tactypes.with_bindings option [@@deriving sexp,hash,compare] type glb = Genintern.glob_constr_and_expr Tactypes.with_bindings option [@@deriving sexp,hash,compare] type top = EConstr.t Tactypes.with_bindings Ser_tactypes.delayed_open option [@@deriving sexp,hash,compare] end let ser_wit_fun_ind_using = let module M = Ser_genarg.GS(WitFI) in M.genser module WitFS = struct type t = Names.variable * Libnames.qualid * Sorts.family [@@deriving sexp,hash,compare] end let ser_wit_fun_scheme_arg = let module M = Ser_genarg.GSV(WitFS) in M.genser module Loc = Ser_loc module Vernacexpr = Ser_vernacexpr module WFFD = struct type t = Vernacexpr.fixpoint_expr Loc.located [@@deriving sexp,hash,compare] end let ser_wit_function_fix_definition = let module M = Ser_genarg.GS0(WFFD) in M.genser module WAU = struct type raw = Constrexpr.constr_expr list [@@deriving sexp,hash,compare] type glb = Genintern.glob_constr_and_expr list [@@deriving sexp,hash,compare] type top = EConstr.constr list [@@deriving sexp,hash,compare] end let ser_wit_auto_using' = let module M = Ser_genarg.GS(WAU) in M.genser let register () = Ser_genarg.register_genser Funind_plugin.G_indfun.wit_auto_using' ser_wit_auto_using'; Ser_genarg.register_genser Funind_plugin.G_indfun.wit_constr_comma_sequence' ser_wit_auto_using'; Ser_genarg.register_genser Funind_plugin.G_indfun.wit_with_names ser_wit_with_names; Ser_genarg.register_genser Funind_plugin.G_indfun.wit_fun_ind_using ser_wit_fun_ind_using; Ser_genarg.register_genser Funind_plugin.G_indfun.wit_fun_scheme_arg ser_wit_fun_scheme_arg; Ser_genarg.register_genser Funind_plugin.G_indfun.wit_function_fix_definition ser_wit_function_fix_definition; () let _ = register () coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac/000077500000000000000000000000001466734233400210075ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac/dune000066400000000000000000000004361466734233400216700ustar00rootroot00000000000000(library (name serlib_ltac) (public_name coq-serapi.serlib.ltac) (synopsis "Serialization Library for Coq [LTAC plugin]") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.ltac serlib sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac/ser_rewrite.ml000066400000000000000000000035321466734233400236760ustar00rootroot00000000000000(************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) (* ITac.TacIntroPattern(a,b) | Ltac_plugin.Tacexpr.TacApply (a,b,c,d) -> ITac.TacApply (a,b,c,d) | Ltac_plugin.Tacexpr.TacElim (a,b,c) -> ITac.TacElim (a,b,c) | Ltac_plugin.Tacexpr.TacCase (a,b) -> ITac.TacCase (a,b) | Ltac_plugin.Tacexpr.TacMutualFix (a,b,c) -> ITac.TacMutualFix (a,b,c) | Ltac_plugin.Tacexpr.TacMutualCofix (a,b) -> ITac.TacMutualCofix (a,b) | Ltac_plugin.Tacexpr.TacAssert (a,b,c,d,e) -> ITac.TacAssert (a,b,c,d,e) | Ltac_plugin.Tacexpr.TacGeneralize a -> ITac.TacGeneralize a | Ltac_plugin.Tacexpr.TacLetTac (a,b,c,d,e,f) -> ITac.TacLetTac (a,b,c,d,e,f) | Ltac_plugin.Tacexpr.TacInductionDestruct (a,b,c) -> ITac.TacInductionDestruct (a,b,c) | Ltac_plugin.Tacexpr.TacReduce (a,b) -> ITac.TacReduce (a,b) | Ltac_plugin.Tacexpr.TacChange (a,b,c,d) -> ITac.TacChange (a,b,c,d) | Ltac_plugin.Tacexpr.TacRewrite (a,b,c,d) -> ITac.TacRewrite (a,b,c,d) | Ltac_plugin.Tacexpr.TacInversion (a,b) -> ITac.TacInversion (a,b) and _gen_tactic_arg_put (t : 'a Ltac_plugin.Tacexpr.gen_tactic_arg) : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_tactic_arg = match t with | Ltac_plugin.Tacexpr.TacGeneric (a,b) -> ITac.TacGeneric (a,b) | Ltac_plugin.Tacexpr.ConstrMayEval a -> ITac.ConstrMayEval a | Ltac_plugin.Tacexpr.Reference a -> ITac.Reference a | Ltac_plugin.Tacexpr.TacCall l -> ITac.TacCall C.(map (fun (b,c) -> (b, List.map _gen_tactic_arg_put c)) l) | Ltac_plugin.Tacexpr.TacFreshId a -> ITac.TacFreshId a | Ltac_plugin.Tacexpr.Tacexp a -> ITac.Tacexp a | Ltac_plugin.Tacexpr.TacPretype a -> ITac.TacPretype a | Ltac_plugin.Tacexpr.TacNumgoals -> ITac.TacNumgoals and _gen_tactic_expr_r_put (t : 'a Ltac_plugin.Tacexpr.gen_tactic_expr_r) : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_tactic_expr_r = let u x = _gen_tactic_expr_put x in let uu x = List.map u x in let ua x = Array.map u x in match t with | Ltac_plugin.Tacexpr.TacAtom l -> ITac.TacAtom (_gen_atomic_tactic_expr_put l) | Ltac_plugin.Tacexpr.TacThen (a,b) -> ITac.TacThen (u a, u b) | Ltac_plugin.Tacexpr.TacDispatch a -> ITac.TacDispatch (uu a) | Ltac_plugin.Tacexpr.TacExtendTac (a,b,c) -> ITac.TacExtendTac (ua a, u b, ua c) | Ltac_plugin.Tacexpr.TacThens (a,b) -> ITac.TacThens (u a, uu b) | Ltac_plugin.Tacexpr.TacThens3parts (a,b,c,d) -> ITac.TacThens3parts (u a, ua b, u c, ua d) | Ltac_plugin.Tacexpr.TacFirst a -> ITac.TacFirst (uu a) | Ltac_plugin.Tacexpr.TacSolve a -> ITac.TacSolve (uu a) | Ltac_plugin.Tacexpr.TacTry a -> ITac.TacTry (u a) | Ltac_plugin.Tacexpr.TacOr (a,b) -> ITac.TacOr (u a, u b) | Ltac_plugin.Tacexpr.TacOnce a -> ITac.TacOnce (u a) | Ltac_plugin.Tacexpr.TacExactlyOnce a -> ITac.TacExactlyOnce (u a) | Ltac_plugin.Tacexpr.TacIfThenCatch (a,b,c) -> ITac.TacIfThenCatch (u a,u b,u c) | Ltac_plugin.Tacexpr.TacOrelse (a,b) -> ITac.TacOrelse (u a,u b) | Ltac_plugin.Tacexpr.TacDo (a,b) -> ITac.TacDo (a,u b) | Ltac_plugin.Tacexpr.TacTimeout (a,b) -> ITac.TacTimeout (a,u b) | Ltac_plugin.Tacexpr.TacTime (a,b) -> ITac.TacTime (a,u b) | Ltac_plugin.Tacexpr.TacRepeat a -> ITac.TacRepeat (u a) | Ltac_plugin.Tacexpr.TacProgress a -> ITac.TacProgress (u a) (* | Ltac_plugin.Tacexpr.TacShowHyps a -> ITac.TacShowHyps (u a) *) | Ltac_plugin.Tacexpr.TacAbstract (a,b) -> ITac.TacAbstract (u a,b) | Ltac_plugin.Tacexpr.TacId a -> ITac.TacId a | Ltac_plugin.Tacexpr.TacFail (a,b,c) -> ITac.TacFail (a,b,c) (* | Ltac_plugin.Tacexpr.TacInfo a -> ITac.TacInfo (u a) *) (* | TacLetIn of rec_flag * *) (* (Names.Id.t located * 'a gen_tactic_arg) list * *) (* 'a gen_tactic_expr *) | Ltac_plugin.Tacexpr.TacLetIn (a, l, t) -> let _pt = List.map (fun (a,t) -> (a,_gen_tactic_arg_put t)) in ITac.TacLetIn (a, _pt l, _gen_tactic_expr_put t) (* | TacMatch of lazy_flag * *) (* 'a gen_tactic_expr * *) (* ('p,'a gen_tactic_expr) match_rule list *) (* type ('a,'t) match_rule = *) (* | Pat of 'a match_context_hyps list * 'a match_pattern * 't *) (* | All of 't *) | Ltac_plugin.Tacexpr.TacMatch (a, e, mr) -> let _pmr = List.map (function | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_put t) | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_put e) ) in ITac.TacMatch(a, _gen_tactic_expr_put e, _pmr mr) | Ltac_plugin.Tacexpr.TacMatchGoal (e, d, t) -> let _pmr = List.map (function | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_put t) | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_put e) ) in ITac.TacMatchGoal(e, d, _pmr t) | Ltac_plugin.Tacexpr.TacFun a -> ITac.TacFun (_gen_tactic_fun_ast_put a) | Ltac_plugin.Tacexpr.TacArg l -> ITac.TacArg (_gen_tactic_arg_put l) | Ltac_plugin.Tacexpr.TacSelect(gs,te) -> ITac.TacSelect(gs, _gen_tactic_expr_put te) | Ltac_plugin.Tacexpr.TacML (l,m) -> ITac.TacML (l, List.map _gen_tactic_arg_put m) | Ltac_plugin.Tacexpr.TacAlias (l,m) -> ITac.TacAlias (l, List.map _gen_tactic_arg_put m) and _gen_tactic_expr_put (t : _ Ltac_plugin.Tacexpr.gen_tactic_expr) = C.map _gen_tactic_expr_r_put t and _gen_tactic_fun_ast_put (t : 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast) : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_tactic_fun_ast = match t with | (a,b) -> (a, _gen_tactic_expr_put b) let rec _gen_atom_tactic_expr_get (t : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_atomic_tactic_expr) : 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr = match t with | ITac.TacIntroPattern(a,b) -> Ltac_plugin.Tacexpr.TacIntroPattern(a,b) | ITac.TacApply (a,b,c,d) -> Ltac_plugin.Tacexpr.TacApply (a,b,c,d) | ITac.TacElim (a,b,c) -> Ltac_plugin.Tacexpr.TacElim (a,b,c) | ITac.TacCase (a,b) -> Ltac_plugin.Tacexpr.TacCase (a,b) | ITac.TacMutualFix (a,b,c) -> Ltac_plugin.Tacexpr.TacMutualFix (a,b,c) | ITac.TacMutualCofix (a,b) -> Ltac_plugin.Tacexpr.TacMutualCofix (a,b) | ITac.TacAssert (a,b,c,d,e) -> Ltac_plugin.Tacexpr.TacAssert (a,b,c,d,e) | ITac.TacGeneralize a -> Ltac_plugin.Tacexpr.TacGeneralize a | ITac.TacLetTac (a,b,c,d,e,f) -> Ltac_plugin.Tacexpr.TacLetTac (a,b,c,d,e,f) | ITac.TacInductionDestruct (a,b,c) -> Ltac_plugin.Tacexpr.TacInductionDestruct (a,b,c) | ITac.TacReduce (a,b) -> Ltac_plugin.Tacexpr.TacReduce (a,b) | ITac.TacChange (a,b,c,d) -> Ltac_plugin.Tacexpr.TacChange (a,b,c,d) | ITac.TacRewrite (a,b,c,d) -> Ltac_plugin.Tacexpr.TacRewrite (a,b,c,d) | ITac.TacInversion (a,b) -> Ltac_plugin.Tacexpr.TacInversion (a,b) and _gen_tactic_arg_get (t : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_tactic_arg) : 'a Ltac_plugin.Tacexpr.gen_tactic_arg = match t with | ITac.TacGeneric(a,b) -> Ltac_plugin.Tacexpr.TacGeneric (a,b) | ITac.ConstrMayEval a -> Ltac_plugin.Tacexpr.ConstrMayEval a | ITac.Reference a -> Ltac_plugin.Tacexpr.Reference a | ITac.TacCall l -> Ltac_plugin.Tacexpr.TacCall C.(map (fun (b,c) -> (b, List.map _gen_tactic_arg_get c)) l) | ITac.TacFreshId a -> Ltac_plugin.Tacexpr.TacFreshId a | ITac.Tacexp a -> Ltac_plugin.Tacexpr.Tacexp a | ITac.TacPretype a -> Ltac_plugin.Tacexpr.TacPretype a | ITac.TacNumgoals -> Ltac_plugin.Tacexpr.TacNumgoals and _gen_tactic_expr_r_get (t : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_tactic_expr_r) : 'a Ltac_plugin.Tacexpr.gen_tactic_expr_r = let u x = _gen_tactic_expr_get x in let uu x = List.map u x in let ua x = Array.map u x in match t with | ITac.TacAtom l -> Ltac_plugin.Tacexpr.TacAtom (_gen_atom_tactic_expr_get l) | ITac.TacThen (a,b) -> Ltac_plugin.Tacexpr.TacThen (u a, u b) | ITac.TacDispatch a -> Ltac_plugin.Tacexpr.TacDispatch (uu a) | ITac.TacExtendTac (a,b,c) -> Ltac_plugin.Tacexpr.TacExtendTac (ua a, u b, ua c) | ITac.TacThens (a,b) -> Ltac_plugin.Tacexpr.TacThens (u a, uu b) | ITac.TacThens3parts (a,b,c,d) -> Ltac_plugin.Tacexpr.TacThens3parts (u a, ua b, u c, ua d) | ITac.TacFirst a -> Ltac_plugin.Tacexpr.TacFirst (uu a) | ITac.TacSolve a -> Ltac_plugin.Tacexpr.TacSolve (uu a) | ITac.TacTry a -> Ltac_plugin.Tacexpr.TacTry (u a) | ITac.TacOr (a,b) -> Ltac_plugin.Tacexpr.TacOr (u a, u b) | ITac.TacOnce a -> Ltac_plugin.Tacexpr.TacOnce (u a) | ITac.TacExactlyOnce a -> Ltac_plugin.Tacexpr.TacExactlyOnce (u a) | ITac.TacIfThenCatch (a,b,c) -> Ltac_plugin.Tacexpr.TacIfThenCatch (u a,u b,u c) | ITac.TacOrelse (a,b) -> Ltac_plugin.Tacexpr.TacOrelse (u a,u b) | ITac.TacDo (a,b) -> Ltac_plugin.Tacexpr.TacDo (a,u b) | ITac.TacTimeout (a,b) -> Ltac_plugin.Tacexpr.TacTimeout (a,u b) | ITac.TacTime (a,b) -> Ltac_plugin.Tacexpr.TacTime (a,u b) | ITac.TacRepeat a -> Ltac_plugin.Tacexpr.TacRepeat (u a) | ITac.TacProgress a -> Ltac_plugin.Tacexpr.TacProgress (u a) (* | ITac.TacShowHyps a -> Ltac_plugin.Tacexpr.TacShowHyps (u a) *) | ITac.TacAbstract (a,b) -> Ltac_plugin.Tacexpr.TacAbstract (u a,b) | ITac.TacId a -> Ltac_plugin.Tacexpr.TacId a | ITac.TacFail (a,b,c) -> Ltac_plugin.Tacexpr.TacFail (a,b,c) (* | ITac.TacInfo a -> Ltac_plugin.Tacexpr.TacInfo (u a) *) | ITac.TacLetIn (a, l, t) -> let _pt = List.map (fun (a,t) -> (a,_gen_tactic_arg_get t)) in Ltac_plugin.Tacexpr.TacLetIn (a, _pt l, _gen_tactic_expr_get t) | ITac.TacMatch (a,e,mr) -> let _gmr = List.map (function | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_get t) | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_get e) ) in Ltac_plugin.Tacexpr.TacMatch(a, _gen_tactic_expr_get e, _gmr mr) | ITac.TacMatchGoal (a,d,t) -> let _gmr = List.map (function | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_get t) | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_get e) ) in Ltac_plugin.Tacexpr.TacMatchGoal(a,d, _gmr t) | ITac.TacFun a -> Ltac_plugin.Tacexpr.TacFun (_gen_tactic_fun_ast_get a) | ITac.TacArg l -> Ltac_plugin.Tacexpr.TacArg (_gen_tactic_arg_get l) | ITac.TacSelect(gs,te) -> Ltac_plugin.Tacexpr.TacSelect(gs, _gen_tactic_expr_get te) | ITac.TacML (l,m) -> Ltac_plugin.Tacexpr.TacML (l, List.map _gen_tactic_arg_get m) | ITac.TacAlias (l,m) -> Ltac_plugin.Tacexpr.TacAlias (l, List.map _gen_tactic_arg_get m) and _gen_tactic_expr_get (t : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_tactic_expr) : 'a Ltac_plugin.Tacexpr.gen_tactic_expr = C.map _gen_tactic_expr_r_get t and _gen_tactic_fun_ast_get (t : ('t, 'dtrm, 'p, 'rp, 'c, 'r, 'n, 'occvar, 'tacexpr, 'l) ITac.gen_tactic_fun_ast) : 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast = match t with | (a,b) -> (a, _gen_tactic_expr_get b) type 'd gen_atomic_tactic_expr = 'd Ltac_plugin.Tacexpr.gen_atomic_tactic_expr (* Sexp part for generic functions *) let sexp_of_gen_atomic_tactic_expr t d p rp c r n ov te l (tac : 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr) : Sexp.t = ITac.sexp_of_gen_atomic_tactic_expr t d p rp c r n ov te l (_gen_atomic_tactic_expr_put tac) let sexp_of_gen_tactic_expr t d p rp c r n ov te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_expr) : Sexp.t = ITac.sexp_of_gen_tactic_expr t d p rp c r n ov te l (_gen_tactic_expr_put tac) let sexp_of_gen_tactic_arg t d p rp c r n ov te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_arg) : Sexp.t = ITac.sexp_of_gen_tactic_arg t d p rp c r n ov te l (_gen_tactic_arg_put tac) let sexp_of_gen_fun_ast t d p rp c r n ov te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast) : Sexp.t = ITac.sexp_of_gen_tactic_fun_ast t d p rp c r n ov te l (_gen_tactic_fun_ast_put tac) let gen_atomic_tactic_expr_of_sexp (tac : Sexp.t) t d p rp c r n ov te l : 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr = _gen_atom_tactic_expr_get (ITac.gen_atomic_tactic_expr_of_sexp t d p rp c r n ov te l tac) let gen_tactic_expr_of_sexp (tac : Sexp.t) t d p rp c r n ov te l : 'a Ltac_plugin.Tacexpr.gen_tactic_expr = _gen_tactic_expr_get (ITac.gen_tactic_expr_of_sexp t d p rp c r n ov te l tac) let gen_tactic_arg_of_sexp (tac : Sexp.t) t d p rp c r n ov te l : 'a Ltac_plugin.Tacexpr.gen_tactic_arg = _gen_tactic_arg_get (ITac.gen_tactic_arg_of_sexp t d p rp c r n ov te l tac) let gen_fun_ast_of_sexp (tac : Sexp.t) t d p rp c r n ov te l : 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast = _gen_tactic_fun_ast_get (ITac.gen_tactic_fun_ast_of_sexp t d p rp c r n ov te l tac) (* Yojson part for generic functions *) let gen_atomic_tactic_expr_to_yojson t d p rp c r n ov te l (tac : 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr) : _ = ITac.gen_atomic_tactic_expr_to_yojson t d p rp c r n ov te l (_gen_atomic_tactic_expr_put tac) let gen_tactic_expr_to_yojson t d p rp c r n ov te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_expr) : Yojson.Safe.t = ITac.gen_tactic_expr_to_yojson t d p rp c r n ov te l (_gen_tactic_expr_put tac) let gen_tactic_expr_of_yojson tac t d p rp c r n ov te l : ('a Ltac_plugin.Tacexpr.gen_tactic_expr, _) result = Result.map _gen_tactic_expr_get (ITac.gen_tactic_expr_of_yojson t d p rp c r n ov te l tac) let gen_atomic_tactic_expr_of_yojson tac t d p rp c r n ov te l : ('a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr, _) result = Result.map _gen_atom_tactic_expr_get (ITac.gen_atomic_tactic_expr_of_yojson t d p rp c r n ov te l tac) (* Hash part for generic functions *) let hash_fold_gen_tactic_expr t d p rp c r n ov te l st tac = ITac.hash_fold_gen_tactic_expr t d p rp c r n ov te l st (_gen_tactic_expr_put tac) let hash_fold_gen_atomic_tactic_expr t d p rp c r n ov te l st tac = ITac.hash_fold_gen_atomic_tactic_expr t d p rp c r n ov te l st (_gen_atomic_tactic_expr_put tac) (* Compare part for generic functions *) let compare_gen_tactic_expr t d p rp c r n ov te l t1 t2 : int = ITac.compare_gen_tactic_expr t d p rp c r n ov te l (_gen_tactic_expr_put t1) (_gen_tactic_expr_put t2) let compare_gen_atomic_tactic_expr t d p rp c r n ov te l t1 t2 = ITac.compare_gen_atomic_tactic_expr t d p rp c r n ov te l (_gen_atomic_tactic_expr_put t1) (_gen_atomic_tactic_expr_put t2) (************************************************************************) (* Main tactics types, we follow tacexpr and provide glob,raw, and *) (* atomic *) (************************************************************************) (* Glob *) type glob_tactic_expr = Ltac_plugin.Tacexpr.glob_tactic_expr type glob_atomic_tactic_expr = Ltac_plugin.Tacexpr.glob_atomic_tactic_expr let rec glob_tactic_expr_of_sexp tac = gen_tactic_expr_of_sexp tac Genintern.glob_constr_and_expr_of_sexp Genintern.glob_constr_and_expr_of_sexp Genintern.glob_constr_pattern_and_expr_of_sexp Genintern.glob_constr_and_expr_of_sexp (Locus.or_var_of_sexp (Genredexpr.and_short_name_of_sexp Evaluable.t_of_sexp)) (Locus.or_var_of_sexp (Loc.located_of_sexp ltac_constant_of_sexp)) Names.lident_of_sexp (Locus.or_var_of_sexp int_of_sexp) glob_tactic_expr_of_sexp Genarg.glevel_of_sexp and glob_atomic_tactic_expr_of_sexp tac = gen_atomic_tactic_expr_of_sexp tac Genintern.glob_constr_and_expr_of_sexp Genintern.glob_constr_and_expr_of_sexp Genintern.glob_constr_pattern_and_expr_of_sexp Genintern.glob_constr_and_expr_of_sexp (Locus.or_var_of_sexp (Genredexpr.and_short_name_of_sexp Evaluable.t_of_sexp)) (Locus.or_var_of_sexp (Loc.located_of_sexp ltac_constant_of_sexp)) Names.lident_of_sexp (Locus.or_var_of_sexp int_of_sexp) glob_tactic_expr_of_sexp Genarg.glevel_of_sexp let rec sexp_of_glob_tactic_expr (tac : glob_tactic_expr) = sexp_of_gen_tactic_expr Genintern.sexp_of_glob_constr_and_expr Genintern.sexp_of_glob_constr_and_expr Genintern.sexp_of_glob_constr_pattern_and_expr Genintern.sexp_of_glob_constr_and_expr (Locus.sexp_of_or_var (Genredexpr.sexp_of_and_short_name Evaluable.sexp_of_t)) (Locus.sexp_of_or_var (Loc.sexp_of_located sexp_of_ltac_constant)) Names.sexp_of_lident (Locus.sexp_of_or_var sexp_of_int) sexp_of_glob_tactic_expr Genarg.sexp_of_glevel tac and sexp_of_glob_atomic_tactic_expr (tac : glob_atomic_tactic_expr) = sexp_of_gen_atomic_tactic_expr Genintern.sexp_of_glob_constr_and_expr Genintern.sexp_of_glob_constr_and_expr Genintern.sexp_of_glob_constr_pattern_and_expr Genintern.sexp_of_glob_constr_and_expr (Locus.sexp_of_or_var (Genredexpr.sexp_of_and_short_name Evaluable.sexp_of_t)) (Locus.sexp_of_or_var (Loc.sexp_of_located sexp_of_ltac_constant)) Names.sexp_of_lident (Locus.sexp_of_or_var sexp_of_int) sexp_of_glob_tactic_expr Genarg.sexp_of_glevel tac let rec glob_tactic_expr_of_yojson tac = gen_tactic_expr_of_yojson tac Genintern.glob_constr_and_expr_of_yojson Genintern.glob_constr_and_expr_of_yojson Genintern.glob_constr_pattern_and_expr_of_yojson Genintern.glob_constr_and_expr_of_yojson (Locus.or_var_of_yojson (Genredexpr.and_short_name_of_yojson Evaluable.of_yojson)) (Locus.or_var_of_yojson (Loc.located_of_yojson ltac_constant_of_yojson)) Names.lident_of_yojson (Locus.or_var_of_yojson Ser_int.of_yojson) glob_tactic_expr_of_yojson Genarg.glevel_of_yojson and glob_atomic_tactic_expr_of_yojson tac = gen_atomic_tactic_expr_of_yojson tac Genintern.glob_constr_and_expr_of_yojson Genintern.glob_constr_and_expr_of_yojson Genintern.glob_constr_pattern_and_expr_of_yojson Genintern.glob_constr_and_expr_of_yojson (Locus.or_var_of_yojson (Genredexpr.and_short_name_of_yojson Evaluable.of_yojson)) (Locus.or_var_of_yojson (Loc.located_of_yojson ltac_constant_of_yojson)) Names.lident_of_yojson (Locus.or_var_of_yojson Ser_int.of_yojson) glob_tactic_expr_of_yojson Genarg.glevel_of_yojson let rec glob_tactic_expr_to_yojson tac = gen_tactic_expr_to_yojson Genintern.glob_constr_and_expr_to_yojson Genintern.glob_constr_and_expr_to_yojson Genintern.glob_constr_pattern_and_expr_to_yojson Genintern.glob_constr_and_expr_to_yojson (Locus.or_var_to_yojson (Genredexpr.and_short_name_to_yojson Evaluable.to_yojson)) (Locus.or_var_to_yojson (Loc.located_to_yojson ltac_constant_to_yojson)) Names.lident_to_yojson (Locus.or_var_to_yojson Ser_int.to_yojson) glob_tactic_expr_to_yojson Genarg.glevel_to_yojson tac and glob_atomic_tactic_expr_to_yojson tac = gen_atomic_tactic_expr_to_yojson Genintern.glob_constr_and_expr_to_yojson Genintern.glob_constr_and_expr_to_yojson Genintern.glob_constr_pattern_and_expr_to_yojson Genintern.glob_constr_and_expr_to_yojson (Locus.or_var_to_yojson (Genredexpr.and_short_name_to_yojson Evaluable.to_yojson)) (Locus.or_var_to_yojson (Loc.located_to_yojson ltac_constant_to_yojson)) Names.lident_to_yojson (Locus.or_var_to_yojson Ser_int.to_yojson) glob_tactic_expr_to_yojson Genarg.glevel_to_yojson tac let rec hash_fold_glob_tactic_expr st tac = hash_fold_gen_tactic_expr Genintern.hash_fold_glob_constr_and_expr Genintern.hash_fold_glob_constr_and_expr Genintern.hash_fold_glob_constr_pattern_and_expr Genintern.hash_fold_glob_constr_and_expr (Locus.hash_fold_or_var (Genredexpr.hash_fold_and_short_name Evaluable.hash_fold_t)) (Locus.hash_fold_or_var (Loc.hash_fold_located hash_fold_ltac_constant)) Names.hash_fold_lident (Locus.hash_fold_or_var Ser_int.hash_fold_t) hash_fold_glob_tactic_expr Genarg.hash_fold_glevel st tac and hash_fold_glob_atomic_tactic_expr st tac = hash_fold_gen_atomic_tactic_expr Genintern.hash_fold_glob_constr_and_expr Genintern.hash_fold_glob_constr_and_expr Genintern.hash_fold_glob_constr_pattern_and_expr Genintern.hash_fold_glob_constr_and_expr (Locus.hash_fold_or_var (Genredexpr.hash_fold_and_short_name Evaluable.hash_fold_t)) (Locus.hash_fold_or_var (Loc.hash_fold_located hash_fold_ltac_constant)) Names.hash_fold_lident (Locus.hash_fold_or_var Ser_int.hash_fold_t) hash_fold_glob_tactic_expr Genarg.hash_fold_glevel st tac let hash_glob_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_glob_tactic_expr let hash_glob_atomic_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_glob_atomic_tactic_expr let rec compare_glob_tactic_expr tac = compare_gen_tactic_expr Genintern.compare_glob_constr_and_expr Genintern.compare_glob_constr_and_expr Genintern.compare_glob_constr_pattern_and_expr Genintern.compare_glob_constr_and_expr (Locus.compare_or_var (Genredexpr.compare_and_short_name Evaluable.compare)) (Locus.compare_or_var (Loc.compare_located compare_ltac_constant)) Names.compare_lident (Locus.compare_or_var Ser_int.compare) compare_glob_tactic_expr Genarg.compare_glevel tac and compare_glob_atomic_tactic_expr tac = compare_gen_atomic_tactic_expr Genintern.compare_glob_constr_and_expr Genintern.compare_glob_constr_and_expr Genintern.compare_glob_constr_pattern_and_expr Genintern.compare_glob_constr_and_expr (Locus.compare_or_var (Genredexpr.compare_and_short_name Evaluable.compare)) (Locus.compare_or_var (Loc.compare_located compare_ltac_constant)) Names.compare_lident (Locus.compare_or_var Ser_int.compare) compare_glob_tactic_expr Genarg.compare_glevel tac (* Raw *) type raw_tactic_expr = Ltac_plugin.Tacexpr.raw_tactic_expr type raw_atomic_tactic_expr = Ltac_plugin.Tacexpr.raw_atomic_tactic_expr let rec raw_tactic_expr_of_sexp tac = gen_tactic_expr_of_sexp tac Constrexpr.constr_expr_of_sexp Constrexpr.constr_expr_of_sexp Constrexpr.constr_pattern_expr_of_sexp Constrexpr.constr_expr_of_sexp (Constrexpr.or_by_notation_of_sexp Libnames.qualid_of_sexp) Libnames.qualid_of_sexp Names.lident_of_sexp (Locus.or_var_of_sexp Ser_int.t_of_sexp) raw_tactic_expr_of_sexp Genarg.rlevel_of_sexp and raw_atomic_tactic_expr_of_sexp tac = gen_atomic_tactic_expr_of_sexp tac Constrexpr.constr_expr_of_sexp Constrexpr.constr_expr_of_sexp Constrexpr.constr_pattern_expr_of_sexp Constrexpr.constr_expr_of_sexp (Constrexpr.or_by_notation_of_sexp Libnames.qualid_of_sexp) Libnames.qualid_of_sexp Names.lident_of_sexp (Locus.or_var_of_sexp Ser_int.t_of_sexp) raw_tactic_expr_of_sexp Genarg.rlevel_of_sexp let rec sexp_of_raw_tactic_expr (tac : raw_tactic_expr) = sexp_of_gen_tactic_expr Constrexpr.sexp_of_constr_expr Constrexpr.sexp_of_constr_expr Constrexpr.sexp_of_constr_pattern_expr Constrexpr.sexp_of_constr_expr (Constrexpr.sexp_of_or_by_notation Libnames.sexp_of_qualid) Libnames.sexp_of_qualid Names.sexp_of_lident (Locus.sexp_of_or_var Ser_int.sexp_of_t) sexp_of_raw_tactic_expr Genarg.sexp_of_rlevel tac and sexp_of_raw_atomic_tactic_expr tac = sexp_of_gen_atomic_tactic_expr Constrexpr.sexp_of_constr_expr Constrexpr.sexp_of_constr_expr Constrexpr.sexp_of_constr_pattern_expr Constrexpr.sexp_of_constr_expr (Constrexpr.sexp_of_or_by_notation Libnames.sexp_of_qualid) Libnames.sexp_of_qualid Names.sexp_of_lident (Locus.sexp_of_or_var Ser_int.sexp_of_t) sexp_of_raw_tactic_expr Genarg.sexp_of_rlevel tac (* Yojson *) let rec raw_tactic_expr_of_yojson tac = gen_tactic_expr_of_yojson tac Constrexpr.constr_expr_of_yojson Constrexpr.constr_expr_of_yojson Constrexpr.constr_pattern_expr_of_yojson Constrexpr.constr_expr_of_yojson (Constrexpr.or_by_notation_of_yojson Libnames.qualid_of_yojson) Libnames.qualid_of_yojson Names.lident_of_yojson (Locus.or_var_of_yojson Ser_int.of_yojson) raw_tactic_expr_of_yojson Genarg.rlevel_of_yojson and raw_atomic_tactic_expr_of_yojson tac = gen_atomic_tactic_expr_of_yojson tac Constrexpr.constr_expr_of_yojson Constrexpr.constr_expr_of_yojson Constrexpr.constr_pattern_expr_of_yojson Constrexpr.constr_expr_of_yojson (Constrexpr.or_by_notation_of_yojson Libnames.qualid_of_yojson) Libnames.qualid_of_yojson Names.lident_of_yojson (Locus.or_var_of_yojson Ser_int.of_yojson) raw_tactic_expr_of_yojson Genarg.rlevel_of_yojson let rec raw_tactic_expr_to_yojson (tac : raw_tactic_expr) = gen_tactic_expr_to_yojson Constrexpr.constr_expr_to_yojson Constrexpr.constr_expr_to_yojson Constrexpr.constr_pattern_expr_to_yojson Constrexpr.constr_expr_to_yojson (Constrexpr.or_by_notation_to_yojson Libnames.qualid_to_yojson) Libnames.qualid_to_yojson Names.lident_to_yojson (Locus.or_var_to_yojson Ser_int.to_yojson) raw_tactic_expr_to_yojson Genarg.rlevel_to_yojson tac and raw_atomic_tactic_expr_to_yojson tac = gen_atomic_tactic_expr_to_yojson Constrexpr.constr_expr_to_yojson Constrexpr.constr_expr_to_yojson Constrexpr.constr_pattern_expr_to_yojson Constrexpr.constr_expr_to_yojson (Constrexpr.or_by_notation_to_yojson Libnames.qualid_to_yojson) Libnames.qualid_to_yojson Names.lident_to_yojson (Locus.or_var_to_yojson Ser_int.to_yojson) raw_tactic_expr_to_yojson Genarg.rlevel_to_yojson tac let rec hash_fold_raw_tactic_expr st tac = hash_fold_gen_tactic_expr Constrexpr.hash_fold_constr_expr Constrexpr.hash_fold_constr_expr Constrexpr.hash_fold_constr_pattern_expr Constrexpr.hash_fold_constr_expr (Constrexpr.hash_fold_or_by_notation Libnames.hash_fold_qualid) Libnames.hash_fold_qualid Names.hash_fold_lident (Locus.hash_fold_or_var Ser_int.hash_fold_t) hash_fold_raw_tactic_expr Genarg.hash_fold_rlevel st tac and hash_fold_raw_atomic_tactic_expr st tac = hash_fold_gen_atomic_tactic_expr Constrexpr.hash_fold_constr_expr Constrexpr.hash_fold_constr_expr Constrexpr.hash_fold_constr_pattern_expr Constrexpr.hash_fold_constr_expr (Constrexpr.hash_fold_or_by_notation Libnames.hash_fold_qualid) Libnames.hash_fold_qualid Names.hash_fold_lident (Locus.hash_fold_or_var Ser_int.hash_fold_t) hash_fold_raw_tactic_expr Genarg.hash_fold_rlevel st tac let hash_raw_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_raw_tactic_expr let hash_raw_atomic_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_raw_atomic_tactic_expr let rec compare_raw_tactic_expr tac = compare_gen_tactic_expr Constrexpr.compare_constr_expr Constrexpr.compare_constr_expr Constrexpr.compare_constr_pattern_expr Constrexpr.compare_constr_expr (Constrexpr.compare_or_by_notation Libnames.compare_qualid) Libnames.compare_qualid Names.compare_lident (Locus.compare_or_var Ser_int.compare) compare_raw_tactic_expr Genarg.compare_rlevel tac and compare_raw_atomic_tactic_expr tac = compare_gen_atomic_tactic_expr Constrexpr.compare_constr_expr Constrexpr.compare_constr_expr Constrexpr.compare_constr_pattern_expr Constrexpr.compare_constr_expr (Constrexpr.compare_or_by_notation Libnames.compare_qualid) Libnames.compare_qualid Names.compare_lident (Locus.compare_or_var Ser_int.compare) compare_raw_tactic_expr Genarg.compare_rlevel tac (* Atomic *) type atomic_tactic_expr = Ltac_plugin.Tacexpr.atomic_tactic_expr let atomic_tactic_expr_of_sexp tac = gen_atomic_tactic_expr_of_sexp tac EConstr.t_of_sexp Genintern.glob_constr_and_expr_of_sexp Pattern.constr_pattern_of_sexp Pattern.constr_pattern_of_sexp Evaluable.t_of_sexp (Loc.located_of_sexp ltac_constant_of_sexp) Names.Id.t_of_sexp Ser_int.t_of_sexp unit_of_sexp Genarg.tlevel_of_sexp let sexp_of_atomic_tactic_expr tac = sexp_of_gen_atomic_tactic_expr EConstr.sexp_of_t Genintern.sexp_of_glob_constr_and_expr Pattern.sexp_of_constr_pattern Pattern.sexp_of_constr_pattern Evaluable.sexp_of_t (Loc.sexp_of_located sexp_of_ltac_constant) Names.Id.sexp_of_t Ser_int.sexp_of_t sexp_of_unit Genarg.sexp_of_tlevel tac (* Helpers for raw_red_expr *) type tacdef_body = [%import: Ltac_plugin.Tacexpr.tacdef_body] [@@deriving sexp,yojson,hash,compare] (* Unsupported serializers *) type intro_pattern = [%import: Ltac_plugin.Tacexpr.intro_pattern] [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac/ser_tacexpr.mli000066400000000000000000000234171466734233400240400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) (* direction_flag val sexp_of_direction_flag : direction_flag -> Sexp.t type lazy_flag = Tacexpr.lazy_flag = General | Select | Once val lazy_flag_of_sexp : Sexp.t -> lazy_flag val sexp_of_lazy_flag : lazy_flag -> Sexp.t type global_flag = Tacexpr.global_flag = TacGlobal | TacLocal val global_flag_of_sexp : Sexp.t -> global_flag val sexp_of_global_flag : global_flag -> Sexp.t type evars_flag = bool val evars_flag_of_sexp : Sexp.t -> evars_flag val sexp_of_evars_flag : evars_flag -> Sexp.t type rec_flag = bool val rec_flag_of_sexp : Sexp.t -> rec_flag val sexp_of_rec_flag : rec_flag -> Sexp.t type advanced_flag = bool val advanced_flag_of_sexp : Sexp.t -> advanced_flag val sexp_of_advanced_flag : advanced_flag -> Sexp.t type letin_flag = bool val letin_flag_of_sexp : Sexp.t -> letin_flag val sexp_of_letin_flag : letin_flag -> Sexp.t type clear_flag = bool option val clear_flag_of_sexp : Sexp.t -> clear_flag val sexp_of_clear_flag : clear_flag -> Sexp.t (* type debug = Tacexpr.debug = Debug | Info | Off *) (* val debug_of_sexp : Sexp.t -> debug *) (* val sexp_of_debug : debug -> Sexp.t *) (* type goal_selector = Tacexpr.goal_selector *) (* val goal_selector_of_sexp : Sexp.t -> goal_selector *) (* val sexp_of_goal_selector : goal_selector -> Sexp.t *) type ('c, 'd, 'id) inversion_strength = ('c, 'd, 'id) Tacexpr.inversion_strength val inversion_strength_of_sexp : (Sexp.t -> 'c) -> (Sexp.t -> 'd) -> (Sexp.t -> 'id) -> Sexp.t -> ('c, 'd, 'id) inversion_strength val sexp_of_inversion_strength : ('c -> Sexp.t) -> ('d -> Sexp.t) -> ('id -> Sexp.t) -> ('c, 'd, 'id) inversion_strength -> Sexp.t type 'id message_token = 'id Tacexpr.message_token val message_token_of_sexp : (Sexp.t -> 'id) -> Sexp.t -> 'id message_token val sexp_of_message_token : ('id -> Sexp.t) -> 'id message_token -> Sexp.t type ('dconstr, 'id) induction_clause = ('dconstr, 'id) Tacexpr.induction_clause val induction_clause_of_sexp : (Sexp.t -> 'dconstr) -> (Sexp.t -> 'id) -> Sexp.t -> ('dconstr, 'id) induction_clause val sexp_of_induction_clause : ('dconstr -> Sexp.t) -> ('id -> Sexp.t) -> ('dconstr, 'id) induction_clause -> Sexp.t type ('constr, 'dconstr, 'id) induction_clause_list = ('constr, 'dconstr, 'id) Tacexpr.induction_clause_list val induction_clause_list_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> 'dconstr) -> (Sexp.t -> 'id) -> Sexp.t -> ('constr, 'dconstr, 'id) induction_clause_list val sexp_of_induction_clause_list : ('constr -> Sexp.t) -> ('dconstr -> Sexp.t) -> ('id -> Sexp.t) -> ('constr, 'dconstr, 'id) induction_clause_list -> Sexp.t type 'a with_bindings_arg = 'a Tacexpr.with_bindings_arg val with_bindings_arg_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a with_bindings_arg val sexp_of_with_bindings_arg : ('a -> Sexp.t) -> 'a with_bindings_arg -> Sexp.t (* type multi = Tacexpr.multi *) (* val multi_of_sexp : Sexp.t -> multi *) (* val sexp_of_multi : multi -> Sexp.t *) type 'a match_pattern = 'a Tacexpr.match_pattern val match_pattern_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a match_pattern val sexp_of_match_pattern : ('a -> Sexp.t) -> 'a match_pattern -> Sexp.t type 'a match_context_hyps = 'a Tacexpr.match_context_hyps val match_context_hyps_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a match_context_hyps val sexp_of_match_context_hyps : ('a -> Sexp.t) -> 'a match_context_hyps -> Sexp.t type ('a, 't) match_rule = ('a, 't) Tacexpr.match_rule val match_rule_of_sexp : (Sexp.t -> 'a) -> (Sexp.t -> 't) -> Sexp.t -> ('a, 't) match_rule val sexp_of_match_rule : ('a -> Sexp.t) -> ('t -> Sexp.t) -> ('a, 't) match_rule -> Sexp.t type ml_tactic_name = Tacexpr.ml_tactic_name val ml_tactic_name_of_sexp : Sexp.t -> ml_tactic_name val sexp_of_ml_tactic_name : ml_tactic_name -> Sexp.t type 'd gen_atomic_tactic_expr = 'd Tacexpr.gen_atomic_tactic_expr val sexp_of_gen_atomic_tactic_expr : ('a -> Sexplib.Sexp.t) -> ('c -> Sexplib.Sexp.t) -> ('d -> Sexplib.Sexp.t) -> ('rp -> Sexplib.Sexp.t) -> ('e -> Sexplib.Sexp.t) -> ('f -> Sexplib.Sexp.t) -> ('g -> Sexplib.Sexp.t) -> ('occvar -> Sexplib.Sexp.t) -> ('h -> Sexplib.Sexp.t) -> ('i -> Sexplib.Sexp.t) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_atomic_tactic_expr -> Sexplib.Sexp.t val sexp_of_gen_tactic_expr : ('a -> Sexplib.Sexp.t) -> ('c -> Sexplib.Sexp.t) -> ('d -> Sexplib.Sexp.t) -> ('rp -> Sexplib.Sexp.t) -> ('e -> Sexplib.Sexp.t) -> ('f -> Sexplib.Sexp.t) -> ('g -> Sexplib.Sexp.t) -> ('occvar -> Sexplib.Sexp.t) -> ('h -> Sexplib.Sexp.t) -> ('i -> Sexplib.Sexp.t) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_tactic_expr -> Sexplib.Sexp.t val sexp_of_gen_tactic_arg : ('a -> Sexplib.Sexp.t) -> ('c -> Sexplib.Sexp.t) -> ('d -> Sexplib.Sexp.t) -> ('rp -> Sexplib.Sexp.t) -> ('e -> Sexplib.Sexp.t) -> ('f -> Sexplib.Sexp.t) -> ('g -> Sexplib.Sexp.t) -> ('occvar -> Sexplib.Sexp.t) -> ('h -> Sexplib.Sexp.t) -> ('i -> Sexplib.Sexp.t) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_tactic_arg -> Sexplib.Sexp.t val sexp_of_gen_fun_ast : ('a -> Sexplib.Sexp.t) -> ('c -> Sexplib.Sexp.t) -> ('d -> Sexplib.Sexp.t) -> ('rp -> Sexplib.Sexp.t) -> ('e -> Sexplib.Sexp.t) -> ('f -> Sexplib.Sexp.t) -> ('g -> Sexplib.Sexp.t) -> ('occvar -> Sexplib.Sexp.t) -> ('h -> Sexplib.Sexp.t) -> ('i -> Sexplib.Sexp.t) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_tactic_fun_ast -> Sexplib.Sexp.t val gen_atomic_tactic_expr_of_sexp : Sexplib.Sexp.t -> (Sexplib.Sexp.t -> 'a) -> (Sexplib.Sexp.t -> 'c) -> (Sexplib.Sexp.t -> 'd) -> (Sexplib.Sexp.t -> 'rp) -> (Sexplib.Sexp.t -> 'e) -> (Sexplib.Sexp.t -> 'f) -> (Sexplib.Sexp.t -> 'g) -> (Sexplib.Sexp.t -> 'occvar) -> (Sexplib.Sexp.t -> 'h) -> (Sexplib.Sexp.t -> 'i) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_atomic_tactic_expr val gen_tactic_expr_of_sexp : Sexplib.Sexp.t -> (Sexplib.Sexp.t -> 'a) -> (Sexplib.Sexp.t -> 'c) -> (Sexplib.Sexp.t -> 'd) -> (Sexplib.Sexp.t -> 'rp) -> (Sexplib.Sexp.t -> 'e) -> (Sexplib.Sexp.t -> 'f) -> (Sexplib.Sexp.t -> 'g) -> (Sexplib.Sexp.t -> 'occvar) -> (Sexplib.Sexp.t -> 'h) -> (Sexplib.Sexp.t -> 'i) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_tactic_expr val gen_tactic_arg_of_sexp : Sexplib.Sexp.t -> (Sexplib.Sexp.t -> 'a) -> (Sexplib.Sexp.t -> 'c) -> (Sexplib.Sexp.t -> 'd) -> (Sexplib.Sexp.t -> 'rp) -> (Sexplib.Sexp.t -> 'e) -> (Sexplib.Sexp.t -> 'f) -> (Sexplib.Sexp.t -> 'g) -> (Sexplib.Sexp.t -> 'occvar) -> (Sexplib.Sexp.t -> 'h) -> (Sexplib.Sexp.t -> 'i) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_tactic_arg val gen_fun_ast_of_sexp : Sexplib.Sexp.t -> (Sexplib.Sexp.t -> 'a) -> (Sexplib.Sexp.t -> 'c) -> (Sexplib.Sexp.t -> 'd) -> (Sexplib.Sexp.t -> 'rp) -> (Sexplib.Sexp.t -> 'e) -> (Sexplib.Sexp.t -> 'f) -> (Sexplib.Sexp.t -> 'g) -> (Sexplib.Sexp.t -> 'occvar) -> (Sexplib.Sexp.t -> 'h) -> (Sexplib.Sexp.t -> 'i) -> < occvar : 'occvar; red_pattern : 'rp; constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; reference : 'f; tacexpr : 'h; term : 'a; > Tacexpr.gen_tactic_fun_ast type glob_tactic_expr = Tacexpr.glob_tactic_expr [@@deriving sexp,yojson,hash,compare] type glob_atomic_tactic_expr = Tacexpr.glob_atomic_tactic_expr [@@deriving sexp,yojson,hash,compare] type raw_tactic_expr = Tacexpr.raw_tactic_expr [@@deriving sexp,yojson,hash,compare] type raw_atomic_tactic_expr = Tacexpr.raw_atomic_tactic_expr [@@deriving sexp,yojson,hash,compare] type atomic_tactic_expr = Tacexpr.atomic_tactic_expr val atomic_tactic_expr_of_sexp : Sexp.t -> atomic_tactic_expr val sexp_of_atomic_tactic_expr : atomic_tactic_expr -> Sexp.t type tacdef_body = Tacexpr.tacdef_body [@@deriving sexp,hash,compare] type intro_pattern = Tacexpr.intro_pattern [@@deriving sexp,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac2/000077500000000000000000000000001466734233400210715ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac2/dune000066400000000000000000000004421466734233400217470ustar00rootroot00000000000000(library (name serlib_ltac2) (public_name coq-serapi.serlib.ltac2) (synopsis "Serialization Library for Coq [LTAC2 plugin]") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.ltac2 serlib sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac2/ser_g_ltac2.ml000066400000000000000000000023171466734233400236120ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) open Serlib open Ltac2_plugin module Tac2expr = Ser_tac2expr (* val Ltac2_plugin.G_ltac2.wit_ltac2_entry: (Ltac2_plugin.Tac2expr.strexpr, unit, unit) Genarg.genarg_type *) module L2Entry = struct type t = Tac2expr.strexpr [@@deriving sexp,hash,compare] end let ser_wit_ltac2_entry = let module M = Ser_genarg.GSV(L2Entry) in M.genser module L2Expr = struct type t = Tac2expr.raw_tacexpr [@@deriving sexp,hash,compare] end let ser_wit_ltac2_expr = let module M = Ser_genarg.GSV(L2Expr) in M.genser let register () = Ser_genarg.register_genser G_ltac2.wit_ltac2_entry ser_wit_ltac2_entry; Ser_genarg.register_genser G_ltac2.wit_ltac2_expr ser_wit_ltac2_expr; () let () = register () coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac2/ser_tac2env.ml000066400000000000000000000055001466734233400236360ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) open Serlib open Ltac2_plugin open Sexplib.Std open Ppx_hash_lib.Std.Hash.Builtin open Ppx_compare_lib.Builtin module Util = Ser_util module Loc = Ser_loc module CAst = Ser_cAst module Names = Ser_names module Tac2expr = Ser_tac2expr module WL2in1 = struct type raw = Tac2expr.uid CAst.t list * Tac2expr.raw_tacexpr [@@deriving sexp,hash,compare] type glb = Tac2expr.uid list * Tac2expr.glb_tacexpr [@@deriving sexp,hash,compare] type top = Util.Empty.t [@@deriving sexp,hash,compare] end let ser_wit_ltac2in1 = let module M = Ser_genarg.GS(WL2in1) in M.genser module WL2in1V = struct type raw = Tac2expr.uid CAst.t list * Tac2expr.raw_tacexpr [@@deriving sexp,hash,compare] type glb = Tac2expr.glb_tacexpr [@@deriving sexp,hash,compare] type top = Util.Empty.t [@@deriving sexp,hash,compare] end let ser_wit_ltac2in1_val = let module M = Ser_genarg.GS(WL2in1V) in M.genser module WLC2 = struct type raw = Tac2expr.raw_tacexpr [@@deriving sexp,hash,compare] type glb = Names.Id.Set.t * Tac2expr.glb_tacexpr [@@deriving sexp,hash,compare] type top = Util.Empty.t [@@deriving sexp,hash,compare] end let ser_wit_ltac2_constr = let module M = Ser_genarg.GS(WLC2) in M.genser type var_quotation_kind = [%import: Ltac2_plugin.Tac2env.var_quotation_kind] [@@deriving sexp,yojson,hash,compare] module WLQ2 = struct type raw = Names.lident option * Names.lident [@@deriving sexp,hash,compare] type glb = var_quotation_kind * Names.Id.t [@@deriving sexp,hash,compare] type top = Util.Empty.t [@@deriving sexp,hash,compare] end let ser_wit_ltac2_var_quotation = let module M = Ser_genarg.GS(WLQ2) in M.genser module WLV2 = struct type raw = Util.Empty.t [@@deriving sexp,hash,compare] type glb = unit [@@deriving sexp,hash,compare] type top = Util.Empty.t [@@deriving sexp,hash,compare] end let ser_wit_ltac2_val = let module M = Ser_genarg.GS(WLV2) in M.genser let register () = Ser_genarg.register_genser Tac2env.wit_ltac2in1 ser_wit_ltac2in1; Ser_genarg.register_genser Tac2env.wit_ltac2in1_val ser_wit_ltac2in1_val; Ser_genarg.register_genser Tac2env.wit_ltac2_constr ser_wit_ltac2_constr; Ser_genarg.register_genser Tac2env.wit_ltac2_var_quotation ser_wit_ltac2_var_quotation; Ser_genarg.register_genser Tac2env.wit_ltac2_val ser_wit_ltac2_val; () let () = register () coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac2/ser_tac2expr.ml000066400000000000000000000141111466734233400240220ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) open Serlib module Loc = Ser_loc module CAst = Ser_cAst module Names = Ser_names module Libnames = Ser_libnames open Sexplib.Std open Ppx_hash_lib.Std.Hash.Builtin open Ppx_compare_lib.Builtin let hash_fold_array = hash_fold_array_frozen type mutable_flag = [%import: Ltac2_plugin.Tac2expr.mutable_flag] [@@deriving sexp,yojson,hash,compare] type uid = [%import: Ltac2_plugin.Tac2expr.uid] [@@deriving sexp,yojson,hash,compare] type lid = [%import: Ltac2_plugin.Tac2expr.lid] [@@deriving sexp,yojson,hash,compare] type rec_flag = [%import: Ltac2_plugin.Tac2expr.rec_flag] [@@deriving sexp,yojson,hash,compare] type redef_flag = [%import: Ltac2_plugin.Tac2expr.redef_flag] [@@deriving sexp,yojson,hash,compare] type 'a or_relid = [%import: 'a Ltac2_plugin.Tac2expr.or_relid] [@@deriving sexp,yojson,hash,compare] type 'a or_tuple = [%import: 'a Ltac2_plugin.Tac2expr.or_tuple] [@@deriving sexp,yojson,hash,compare] type type_constant = [%import: Ltac2_plugin.Tac2expr.type_constant] [@@deriving sexp,yojson,hash,compare] type raw_typexpr_r = [%import: Ltac2_plugin.Tac2expr.raw_typexpr_r] [@@deriving sexp,yojson,hash,compare] and raw_typexpr = [%import: Ltac2_plugin.Tac2expr.raw_typexpr] [@@deriving sexp,yojson,hash,compare] type raw_typedef = [%import: Ltac2_plugin.Tac2expr.raw_typedef] [@@deriving sexp,yojson,hash,compare] type raw_quant_typedef = [%import: Ltac2_plugin.Tac2expr.raw_quant_typedef] [@@deriving sexp,yojson,hash,compare] type 'a glb_typexpr = [%import: 'a Ltac2_plugin.Tac2expr.glb_typexpr] [@@deriving sexp,yojson,hash,compare] type atom = [%import: Ltac2_plugin.Tac2expr.atom] [@@deriving sexp,yojson,hash,compare] type ltac_constant = [%import: Ltac2_plugin.Tac2expr.ltac_constant] [@@deriving sexp,yojson,hash,compare] type ltac_alias = [%import: Ltac2_plugin.Tac2expr.ltac_alias] [@@deriving sexp,yojson,hash,compare] type ltac_constructor = [%import: Ltac2_plugin.Tac2expr.ltac_constructor] [@@deriving sexp,yojson,hash,compare] type ltac_projection = [%import: Ltac2_plugin.Tac2expr.ltac_projection] [@@deriving sexp,yojson,hash,compare] type raw_patexpr = [%import: Ltac2_plugin.Tac2expr.raw_patexpr] [@@deriving sexp,yojson,hash,compare] and raw_patexpr_r = [%import: Ltac2_plugin.Tac2expr.raw_patexpr_r] [@@deriving sexp,yojson,hash,compare] type tacref = [%import: Ltac2_plugin.Tac2expr.tacref] [@@deriving sexp,yojson,hash,compare] type ml_tactic_name = [%import: Ltac2_plugin.Tac2expr.ml_tactic_name] [@@deriving sexp,yojson,hash,compare] type sexpr = [%import: Ltac2_plugin.Tac2expr.sexpr] [@@deriving sexp,yojson,hash,compare] type ctor_indx = [%import: Ltac2_plugin.Tac2expr.ctor_indx] [@@deriving sexp,yojson,hash,compare] type ctor_data_for_patterns = [%import: Ltac2_plugin.Tac2expr.ctor_data_for_patterns] [@@deriving sexp,yojson,hash,compare] type glb_pat = [%import: Ltac2_plugin.Tac2expr.glb_pat] [@@deriving sexp,yojson,hash,compare] type case_info = [%import: Ltac2_plugin.Tac2expr.case_info] [@@deriving sexp,yojson,hash,compare] type 'a open_match = [%import: 'a Ltac2_plugin.Tac2expr.open_match] [@@deriving sexp,yojson,hash,compare] module ObjS = struct type t = Obj.t let name = "Obj.t" end module Obj = SerType.Opaque(ObjS) module GT2ESpec = struct type t = Ltac2_plugin.Tac2expr.glb_tacexpr open Ltac2_plugin.Tac2expr type _t = | GTacAtm of atom | GTacVar of Names.Id.t | GTacRef of ltac_constant | GTacFun of Names.Name.t list * _t | GTacApp of _t * _t list | GTacLet of rec_flag * (Names.Name.t * _t) list * _t | GTacCst of case_info * int * _t list | GTacCse of _t * case_info * _t array * (Names.Name.t array * _t) array | GTacPrj of type_constant * _t * int | GTacSet of type_constant * _t * int * _t | GTacOpn of ltac_constructor * _t list | GTacWth of _t open_match | GTacFullMatch of _t * (glb_pat * _t) list | GTacExt of int * Obj.t | GTacPrm of ml_tactic_name [@@deriving sexp,yojson,hash,compare] end module GT2E = Serlib.SerType.Pierce(GT2ESpec) type glb_tacexpr = GT2E.t [@@deriving sexp,yojson,hash,compare] module T2ESpec = struct type t = Ltac2_plugin.Tac2expr.raw_tacexpr_r open Ltac2_plugin.Tac2expr type _t = | CTacAtm of atom | CTacRef of tacref or_relid | CTacCst of ltac_constructor or_tuple or_relid | CTacFun of raw_patexpr list * raw_tacexpr | CTacApp of raw_tacexpr * raw_tacexpr list | CTacSyn of (Names.lname * raw_tacexpr) list * Names.KerName.t | CTacLet of rec_flag * (raw_patexpr * raw_tacexpr) list * Names.KerName.t | CTacCnv of raw_tacexpr * raw_typexpr | CTacSeq of raw_tacexpr * raw_tacexpr | CTacIft of raw_tacexpr * raw_tacexpr * raw_tacexpr | CTacCse of raw_tacexpr * raw_taccase list | CTacRec of raw_tacexpr option * raw_recexpr | CTacPrj of raw_tacexpr * ltac_projection or_relid | CTacSet of raw_tacexpr * ltac_projection or_relid * raw_tacexpr | CTacExt of int * Obj.t | CTacGlb of int * (Names.lname * raw_tacexpr * int glb_typexpr option) list * glb_tacexpr * int glb_typexpr and raw_tacexpr = _t CAst.t and raw_taccase = [%import: Ltac2_plugin.Tac2expr.raw_taccase] and raw_recexpr = [%import: Ltac2_plugin.Tac2expr.raw_recexpr] [@@deriving sexp,yojson,hash,compare] end module T2E = Serlib.SerType.Pierce(T2ESpec) type raw_tacexpr_r = T2E.t [@@deriving sexp,yojson,hash,compare] type raw_tacexpr = [%import: Ltac2_plugin.Tac2expr.raw_tacexpr] [@@deriving sexp,yojson,hash,compare] type strexpr = [%import: Ltac2_plugin.Tac2expr.strexpr] [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ltac2/ser_tac2quote.ml000066400000000000000000000023751466734233400242120ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) (* open Sexplib.Std *) (* open Ppx_hash_lib.Std.Hash.Builtin *) (* open Ppx_compare_lib.Builtin *) (* let b x = Obj.magic x *) (* These are all special ltac2 extensible objects, brrrr... *) let register () = (* Ser_genarg.register_genser Tac2quote.wit_constr (b()); *) (* Ser_genarg.register_genser Tac2quote.wit_ident (b()); *) (* Ser_genarg.register_genser Tac2quote.wit_ltac1 (b()); *) (* Ser_genarg.register_genser Tac2quote.wit_ltac1val (b()); *) (* Ser_genarg.register_genser Tac2quote.wit_open_constr (b()); *) (* Ser_genarg.register_genser Tac2quote.wit_pattern (b()); *) (* Ser_genarg.register_genser Tac2quote.wit_preterm (b()); *) (* Ser_genarg.register_genser Tac2quote.wit_reference (b()); *) () let () = register () coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/micromega/000077500000000000000000000000001466734233400220275ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/micromega/dune000066400000000000000000000004611466734233400227060ustar00rootroot00000000000000(library (name serlib_micromega) (public_name coq-serapi.serlib.micromega) (synopsis "Serialization Library for Coq Congruence Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.micromega serlib sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/micromega_core/000077500000000000000000000000001466734233400230375ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/micromega_core/dune000066400000000000000000000005041466734233400237140ustar00rootroot00000000000000(library (name serlib_micromega_core) (public_name coq-serapi.serlib.micromega_core) (synopsis "Serialization Library for Coq Micromega_core Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.micromega_core serlib sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ring/000077500000000000000000000000001466734233400210235ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ring/dune000066400000000000000000000004171466734233400217030ustar00rootroot00000000000000(library (name serlib_ring) (public_name coq-serapi.serlib.ring) (synopsis "Serialization Library for Coq Setoid Newring Plugin") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare)) (libraries coq-core.plugins.ring serlib serlib_ltac sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ring/ser_g_ring.ml000066400000000000000000000046041466734233400234770ustar00rootroot00000000000000(************************************************************************) (* SerAPI: Coq interaction protocol with bidirectional serialization *) (************************************************************************) (* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) (* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) (* Written by: Emilio J. Gallego Arias and others *) (************************************************************************) open Sexplib.Conv open Ppx_hash_lib.Std.Hash.Builtin open Ppx_compare_lib.Builtin open Serlib module CAst = Ser_cAst module Libnames = Ser_libnames module Constrexpr = Ser_constrexpr module Tactypes = Ser_tactypes module Genintern = Ser_genintern module EConstr = Ser_eConstr module Tacexpr = Serlib_ltac.Ser_tacexpr module Ltac_plugin = struct module Tacexpr = Serlib_ltac.Ser_tacexpr end type 'constr coeff_spec = [%import: 'constr Ring_plugin.Ring_ast.coeff_spec] [@@deriving sexp,hash,compare] type cst_tac_spec = [%import: Ring_plugin.Ring_ast.cst_tac_spec] [@@deriving sexp,hash,compare] type 'constr ring_mod = [%import: 'constr Ring_plugin.Ring_ast.ring_mod] [@@deriving sexp,hash,compare] type 'a field_mod = [%import: 'a Ring_plugin.Ring_ast.field_mod] [@@deriving sexp,hash,compare] module A0 = struct type t = Constrexpr.constr_expr field_mod [@@deriving sexp,hash,compare] end let ser_wit_field_mod = let module M = Ser_genarg.GSV(A0) in M.genser module A1 = struct type t = Constrexpr.constr_expr field_mod list [@@deriving sexp,hash,compare] end let ser_wit_field_mods = let module M = Ser_genarg.GSV(A1) in M.genser module A2 = struct type t = Constrexpr.constr_expr ring_mod [@@deriving sexp,hash,compare] end let ser_wit_ring_mod = let module M = Ser_genarg.GSV(A2) in M.genser module A3 = struct type t = Constrexpr.constr_expr ring_mod list [@@deriving sexp,hash,compare] end let ser_wit_ring_mods = let module M = Ser_genarg.GSV(A3) in M.genser let register () = Ser_genarg.register_genser Ring_plugin.G_ring.wit_field_mod ser_wit_field_mod; Ser_genarg.register_genser Ring_plugin.G_ring.wit_field_mods ser_wit_field_mods; Ser_genarg.register_genser Ring_plugin.G_ring.wit_ring_mod ser_wit_ring_mod; Ser_genarg.register_genser Ring_plugin.G_ring.wit_ring_mods ser_wit_ring_mods; () let _ = register () coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ssr/000077500000000000000000000000001466734233400206735ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ssr/dune000066400000000000000000000005171466734233400215540ustar00rootroot00000000000000(library (name serlib_ssr) (public_name coq-serapi.serlib.ssreflect) (synopsis "Serialization Library for Coq [SSR plugin]") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare)) (libraries coq-core.plugins.ssreflect serlib serlib_ltac serlib_ssrmatching sexplib)) coq-serapi-8.20.0-0.20.0/serlib_8_20/plugins/ssr/ser_ssrast.ml000066400000000000000000000140321466734233400234150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t val of_t : t -> _t end module Biject(M : Bijectable) : SJHC with type t = M.t = struct type t = M.t let sexp_of_t x = M.sexp_of__t (M.of_t x) let t_of_sexp s = M.to_t (M._t_of_sexp s) let to_yojson p = M._t_to_yojson (M.of_t p) let of_yojson p = M._t_of_yojson p |> Result.map M.to_t let hash x = M.hash__t (M.of_t x) let hash_fold_t st x = M.hash_fold__t st (M.of_t x) let compare x1 x2 = M.compare__t (M.of_t x1) (M.of_t x2) end (* Bijection with serializable types *) module type Bijectable1 = sig (* Base Type *) type 'a t (* Representation type *) type 'a _t [@@deriving sexp,yojson,hash,compare] (* Need to be bijetive *) val to_t : 'a _t -> 'a t val of_t : 'a t -> 'a _t end module Biject1(M : Bijectable1) : SJHC1 with type 'a t = 'a M.t = struct type 'a t = 'a M.t let sexp_of_t f x = M.sexp_of__t f (M.of_t x) let t_of_sexp f s = M.to_t (M._t_of_sexp f s) let to_yojson f p = M._t_to_yojson f (M.of_t p) let of_yojson f p = M._t_of_yojson f p |> Result.map M.to_t let hash_fold_t f st x = M.hash_fold__t f st (M.of_t x) let compare f x1 x2 = M.compare__t f (M.of_t x1) (M.of_t x2) end (* We do our own alias as to have better control *) let _sercast = Obj.magic (* Obj.magic piercing *) module type Pierceable = sig (* Type to pierce *) type t (* Representation type *) type _t [@@deriving sexp,yojson,hash,compare] end module type Pierceable1 = sig (* Type to pierce *) type 'a t (* Representation type *) type 'a _t [@@deriving sexp,yojson,hash,compare] end module Pierce(M : Pierceable) : SJHC with type t = M.t = struct type t = M.t let sexp_of_t x = M.sexp_of__t (_sercast x) let t_of_sexp s = _sercast (M._t_of_sexp s) let to_yojson p = M._t_to_yojson (_sercast p) let of_yojson p = M._t_of_yojson p |> Result.map _sercast let hash x = M.hash__t (_sercast x) let hash_fold_t st x = M.hash_fold__t st (_sercast x) let compare x1 x2 = M.compare__t (_sercast x1) (_sercast x2) end module Pierce1(M : Pierceable1) : SJHC1 with type 'a t = 'a M.t = struct type 'a t = 'a M.t let sexp_of_t f x = M.sexp_of__t f (_sercast x) let t_of_sexp f s = _sercast (M._t_of_sexp f s) let to_yojson f p = M._t_to_yojson f (_sercast p) let of_yojson f p = M._t_of_yojson f p |> Result.map _sercast (* let hash x = M.hash__t (_sercast x) *) let hash_fold_t f st x = M.hash_fold__t f st (_sercast x) let compare f x1 x2 = M.compare__t f (_sercast x1) (_sercast x2) end (* Unfortunately this doesn't really work for types that are named as the functions would have to be sexp_of_name etc... Maybe fixme in the future *) module PierceAlt(M : Pierceable) : SJHC with type t := M.t = struct let sexp_of_t x = M.sexp_of__t (_sercast x) let t_of_sexp s = _sercast (M._t_of_sexp s) let to_yojson p = M._t_to_yojson (_sercast p) let of_yojson p = M._t_of_yojson p |> Result.map _sercast let hash x = M.hash__t (_sercast x) let hash_fold_t st x = M.hash_fold__t st (_sercast x) let compare x1 x2 = M.compare__t (_sercast x1) (_sercast x2) end module type OpaqueDesc = sig type t val name : string end module Opaque(M : OpaqueDesc) : SJHC with type t = M.t = struct type t = M.t let typ = M.name let sexp_of_t x = Serlib_base.sexp_of_opaque ~typ x let t_of_sexp s = Serlib_base.opaque_of_sexp ~typ s let to_yojson p = Serlib_base.opaque_to_yojson ~typ p let of_yojson p = Serlib_base.opaque_of_yojson ~typ p let hash x = Serlib_base.hash_opaque ~typ x let hash_fold_t st x = Serlib_base.hash_fold_opaque ~typ st x let compare x1 x2 = Serlib_base.compare_opaque ~typ x1 x2 end module type OpaqueDesc1 = sig type 'a t val name : string end module Opaque1(M : OpaqueDesc1) : SJHC1 with type 'a t = 'a M.t = struct type 'a t = 'a M.t let typ = M.name let sexp_of_t _ x = Serlib_base.sexp_of_opaque ~typ x let t_of_sexp _ s = Serlib_base.opaque_of_sexp ~typ s let to_yojson _ p = Serlib_base.opaque_to_yojson ~typ p let of_yojson _ p = Serlib_base.opaque_of_yojson ~typ p let hash_fold_t _ st x = Serlib_base.hash_fold_opaque ~typ st x let compare _ x1 x2 = Serlib_base.compare_opaque ~typ x1 x2 end coq-serapi-8.20.0-0.20.0/serlib_8_20/serType.mli000066400000000000000000000051461466734233400205470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t val of_t : t -> _t end module Biject(M : Bijectable) : SJHC with type t = M.t (* Bijection with serializable types *) module type Bijectable1 = sig (* Base Type *) type 'a t (* Representation type *) type 'a _t [@@deriving sexp,yojson,hash,compare] (* Need to be bijetive *) val to_t : 'a _t -> 'a t val of_t : 'a t -> 'a _t end module Biject1(M : Bijectable1) : SJHC1 with type 'a t = 'a M.t module type Pierceable = sig (** Type to pierce *) type t (** Representation type *) type _t [@@deriving sexp,yojson,hash,compare] end module type Pierceable1 = sig (** Type to pierce *) type 'a t (** Representation type *) type 'a _t [@@deriving sexp,yojson,hash,compare] end module Pierce(M : Pierceable) : SJHC with type t = M.t module Pierce1(M : Pierceable1) : SJHC1 with type 'a t = 'a M.t module type OpaqueDesc = sig type t val name : string end module Opaque(M : OpaqueDesc) : SJHC with type t = M.t module type OpaqueDesc1 = sig type 'a t val name : string end module Opaque1(M : OpaqueDesc1) : SJHC1 with type 'a t = 'a M.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_attributes.ml000066400000000000000000000031361466734233400217770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* |= fun { L.v; loc } -> CAst.make ?loc:loc v) let to_yojson f { CAst.v ; loc } = L.to_yojson f { L.v ; loc } let hash_fold_t f st { CAst.v; loc } = L.hash_fold_t f st { L.v; loc } let compare f { CAst.v = v1; loc = l1 } { CAst.v = v2; loc = l2 } = L.compare f { L.v = v1; loc = l1 } { L.v = v2; loc = l2 } let omit_att = ref false let sexp_of_t f x = if !omit_att then f x.CAst.v else sexp_of_t f x (* let to_yojson f x = if !omit_att then ... *) coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_cAst.mli000066400000000000000000000024661466734233400206610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* M.add k s e) M.empty l let of_t = M.bindings end include SerType.Biject1(BijectSpec) end coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_cMap.mli000066400000000000000000000026731466734233400206470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* NoInvert | CaseInvert { indices } -> CaseInvert { indices = Array.map f indices } type ('constr, 'r) pcase_branch = [%import: ('constr, 'r) Constr.pcase_branch] [@@deriving sexp,yojson,hash,compare] let map_pcase_branch f (bi, c) = (bi, f c) type ('types, 'r) pcase_return = [%import: ('types, 'r) Constr.pcase_return] [@@deriving sexp,yojson,hash,compare] let map_pcase_return f (bi, c) = (bi, f c) type _constr = | Rel of int | Var of Names.Id.t | Meta of int | Evar of _constr pexistential | Sort of Sorts.t | Cast of _constr * cast_kind * _constr | Prod of (Names.Name.t, Sorts.relevance) Context.pbinder_annot * _constr * _constr | Lambda of (Names.Name.t, Sorts.relevance) Context.pbinder_annot * _constr * _constr | LetIn of (Names.Name.t, Sorts.relevance) Context.pbinder_annot * _constr * _constr * _constr | App of _constr * _constr array | Const of pconstant | Ind of pinductive | Construct of pconstructor | Case of case_info * UVars.Instance.t * _constr array * (_constr, Sorts.relevance) pcase_return * _constr pcase_invert * _constr * (_constr, Sorts.relevance) pcase_branch array | Fix of (_constr, _constr, Sorts.relevance) pfixpoint | CoFix of (_constr, _constr, Sorts.relevance) pcofixpoint | Proj of Names.Projection.t * Sorts.relevance * _constr | Int of Uint63.t | Float of Float64.t | String of Pstring.t | Array of UVars.Instance.t * _constr array * _constr * _constr [@@deriving sexp,yojson,hash,compare] let rec _constr_put (c : Constr.t) : _constr = let cr = _constr_put in let crl = SList.map _constr_put in let cra = Array.map _constr_put in let crci = map_pcase_invert _constr_put in let crcb = map_pcase_branch _constr_put in let crcr = map_pcase_return _constr_put in let module C = Constr in match C.kind c with | C.Rel i -> Rel(i) | C.Var v -> Var(v) | C.Meta(mv) -> Meta mv | C.Evar(ek, csa) -> Evar (ek, crl csa) | C.Sort(st) -> Sort (st) | C.Cast(cs,k,ty) -> Cast(cr cs, k, cr ty) | C.Prod(n,tya,tyr) -> Prod(n, cr tya, cr tyr) | C.Lambda(n,ab,bd) -> Lambda(n, cr ab, cr bd) | C.LetIn(n,u,ab,bd) -> LetIn(n, cr u, cr ab, cr bd) | C.App(hd, al) -> App(cr hd, cra al) | C.Const p -> Const p | C.Ind(p,q) -> Ind (p,q) | C.Construct(p) -> Construct (p) | C.Case(ci, u, ca, (pr,r), pi, c, pb) -> Case(ci, u, cra ca, (crcr pr,r), crci pi, cr c, Array.map crcb pb) (* (int array * int) * (Name.t array * 'types array * 'constr array)) *) | C.Fix(p,(na,u1,u2)) -> Fix(p, (na, cra u1, cra u2)) | C.CoFix(p,(na,u1,u2)) -> CoFix(p, (na, cra u1, cra u2)) | C.Proj(p,r,c) -> Proj(p, r, cr c) | C.Int i -> Int i | C.Float i -> Float i | C.String s -> String s | C.Array (u,a,e,t) -> Array(u, cra a, cr e, cr t) let rec _constr_get (c : _constr) : Constr.t = let cr = _constr_get in let crl = SList.map _constr_get in let cra = Array.map _constr_get in let crci = map_pcase_invert _constr_get in let crcb = map_pcase_branch _constr_get in let crcr = map_pcase_return _constr_get in let module C = Constr in match c with | Rel i -> C.mkRel i | Var v -> C.mkVar v | Meta(mv) -> C.mkMeta mv | Evar(ek, csa) -> C.mkEvar (ek, crl csa) | Sort(st) -> C.mkSort (st) | Cast(cs,k,ty) -> C.mkCast(cr cs, k, cr ty) | Prod(n,tya,tyr) -> C.mkProd(n, cr tya, cr tyr) | Lambda(n,ab,bd) -> C.mkLambda(n, cr ab, cr bd) | LetIn(n,u,ab,bd) -> C.mkLetIn(n, cr u, cr ab, cr bd) | App(hd, al) -> C.mkApp(cr hd, cra al) | Const p -> C.mkConstU(p) | Ind(p,q) -> C.mkIndU(p, q) | Construct(p) -> C.mkConstructU(p) | Case(ci, u, ca, (pr,r), pi, c, pb) -> C.mkCase (ci, u, cra ca, (crcr pr,r), crci pi, cr c, Array.map crcb pb) | Fix (p,(na,u1,u2)) -> C.mkFix(p, (na, cra u1, cra u2)) | CoFix(p,(na,u1,u2)) -> C.mkCoFix(p, (na, cra u1, cra u2)) | Proj(p,r,c) -> C.mkProj(p, r, cr c) | Int i -> C.mkInt i | Float f -> C.mkFloat f | String s -> C.mkString s | Array (u,a,e,t) -> C.mkArray(u, cra a, cr e, cr t) module ConstrBij = struct type t = Constr.t type _t = _constr [@@deriving sexp,yojson,hash,compare] let to_t = _constr_get let of_t = _constr_put end module CC = SerType.Biject(ConstrBij) type constr = CC.t [@@deriving sexp,yojson,hash,compare] type types = CC.t [@@deriving sexp,yojson,hash,compare] type t = constr [@@deriving sexp,yojson,hash,compare] type case_invert = [%import: Constr.case_invert] [@@deriving sexp,yojson] type rec_declaration = [%import: Constr.rec_declaration] [@@deriving sexp] type fixpoint = [%import: Constr.fixpoint] [@@deriving sexp] type cofixpoint = [%import: Constr.cofixpoint] [@@deriving sexp] type existential = [%import: Constr.existential] [@@deriving sexp] type sorts_family = Sorts.family let sorts_family_of_sexp = Sorts.family_of_sexp let sexp_of_sorts_family = Sorts.sexp_of_family type named_declaration = [%import: Constr.named_declaration] [@@deriving sexp,yojson,hash,compare] type named_context = [%import: Constr.named_context] [@@deriving sexp,yojson,hash,compare] type rel_declaration = [%import: Constr.rel_declaration] [@@deriving sexp,yojson,hash,compare] type rel_context = [%import: Constr.rel_context] [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_constr.mli000066400000000000000000000111601466734233400212660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* metavariable val sexp_of_metavariable : metavariable -> Sexp.t type pconstant = Constr.pconstant val pconstant_of_sexp : Sexp.t -> pconstant val sexp_of_pconstant : pconstant -> Sexp.t type pinductive = Constr.pinductive val pinductive_of_sexp : Sexp.t -> pinductive val sexp_of_pinductive : pinductive -> Sexp.t type pconstructor = Constr.pconstructor val pconstructor_of_sexp : Sexp.t -> pconstructor val sexp_of_pconstructor : pconstructor -> Sexp.t type cast_kind = Constr.cast_kind [@@deriving sexp, yojson, hash,compare] type case_style = Constr.case_style [@@deriving sexp, yojson, hash,compare] type case_printing = Constr.case_printing val case_printing_of_sexp : Sexp.t -> case_printing val sexp_of_case_printing : case_printing -> Sexp.t type case_info = Constr.case_info val case_info_of_sexp : Sexp.t -> case_info val sexp_of_case_info : case_info -> Sexp.t type rec_declaration = Constr.rec_declaration val rec_declaration_of_sexp : Sexp.t -> rec_declaration val sexp_of_rec_declaration : rec_declaration -> Sexp.t type fixpoint = Constr.fixpoint val fixpoint_of_sexp : Sexp.t -> fixpoint val sexp_of_fixpoint : fixpoint -> Sexp.t type cofixpoint = Constr.cofixpoint val cofixpoint_of_sexp : Sexp.t -> cofixpoint val sexp_of_cofixpoint : cofixpoint -> Sexp.t type 'constr pexistential = 'constr Constr.pexistential [@@deriving sexp, yojson, hash, compare] type ('constr, 'types, 'r) prec_declaration = ('constr, 'types, 'r) Constr.prec_declaration val prec_declaration_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> (Sexp.t -> 'r) -> Sexp.t -> ('constr, 'types, 'r) prec_declaration val sexp_of_prec_declaration : ('constr -> Sexp.t) -> ('types -> Sexp.t) -> ('r -> Sexp.t) -> ('constr, 'types, 'r) prec_declaration -> Sexp.t type ('constr, 'types, 'r) pfixpoint = ('constr, 'types, 'r) Constr.pfixpoint val pfixpoint_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> (Sexp.t -> 'r) -> Sexp.t -> ('constr, 'types, 'r) pfixpoint val sexp_of_pfixpoint : ('constr -> Sexp.t) -> ('types -> Sexp.t) -> ('r -> Sexp.t) -> ('constr, 'types, 'r) pfixpoint -> Sexp.t type ('constr, 'types, 'r) pcofixpoint = ('constr, 'types, 'r) Constr.pcofixpoint val pcofixpoint_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> (Sexp.t -> 'r) -> Sexp.t -> ('constr, 'types, 'r) pcofixpoint val sexp_of_pcofixpoint : ('constr -> Sexp.t) -> ('types -> Sexp.t) -> ('r -> Sexp.t) -> ('constr, 'types, 'r) pcofixpoint -> Sexp.t type t = Constr.t [@@deriving sexp,yojson,hash,compare] type constr = t [@@deriving sexp,yojson,hash,compare] type types = constr [@@deriving sexp,yojson,hash,compare] type existential = Constr.existential val existential_of_sexp : Sexp.t -> existential val sexp_of_existential : existential -> Sexp.t type sorts_family = Sorts.family val sorts_family_of_sexp : Sexp.t -> sorts_family val sexp_of_sorts_family : sorts_family -> Sexp.t type named_declaration = Constr.named_declaration val named_declaration_of_sexp : Sexp.t -> named_declaration val sexp_of_named_declaration : named_declaration -> Sexp.t type named_context = Constr.named_context [@@deriving sexp,yojson,hash,compare] type rel_declaration = Constr.rel_declaration val rel_declaration_of_sexp : Sexp.t -> rel_declaration val sexp_of_rel_declaration : rel_declaration -> Sexp.t type rel_context = Constr.rel_context [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_constr_matching.ml000066400000000000000000000024511466734233400227720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* binding_bound_vars val sexp_of_binding_bound_vars : binding_bound_vars -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_constrexpr.ml000066400000000000000000000147211466734233400220220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'c) -> (Sexp.t -> 't) -> (Sexp.t -> 'r) -> Sexp.t -> ('c, 't, 'r) pt val sexp_of_pt : ('c -> Sexp.t) -> ('t -> Sexp.t) -> ('r -> Sexp.t) -> ('c, 't, 'r) pt -> Sexp.t end type ('c, 't, 'r) pt = ('c, 't, 'r) Context.Compacted.pt val pt_of_sexp : (Sexp.t -> 'c) -> (Sexp.t -> 't) -> (Sexp.t -> 'r) -> Sexp.t -> ('c, 't, 'r) pt val sexp_of_pt : ('c -> Sexp.t) -> ('t -> Sexp.t) -> ('r -> Sexp.t) -> ('c, 't, 'r) pt -> Sexp.t end coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_conv_oracle.ml000066400000000000000000000030331466734233400220770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t) -> (b -> Sexp.t) -> (a,b) thunk -> Sexp.t = fun f _ t -> match t with | Value v -> f v | Thunk t -> f (Lazy.force t) let thunk_of_sexp : type a b. (Sexp.t -> a) -> (Sexp.t -> b) -> Sexp.t -> (a,b) thunk = fun f _ s -> Value (f s) let thunk_of_yojson : type a b. (Yojson.Safe.t -> (a, string) Result.t) -> (Yojson.Safe.t -> (b, string) Result.t) -> Yojson.Safe.t -> ((a,b) thunk, string) Result.t = fun f _ s -> Result.map (fun s -> Value s) (f s) let thunk_to_yojson : type a b. (a -> Yojson.Safe.t) -> (b -> Yojson.Safe.t) -> (a,b) thunk -> Yojson.Safe.t = fun f _ t -> match t with | Value v -> f v | Thunk t -> f (Lazy.force t) let _hash : type a b. (a -> int) -> (b -> int) -> (a,b) thunk -> int = fun f _ t -> match t with | Value v -> f v | Thunk t -> f (Lazy.force t) let hash_fold_thunk : type a b. (a Ppx_hash_lib.Std.Hash.folder) -> (b Ppx_hash_lib.Std.Hash.folder) -> (a,b) thunk Ppx_hash_lib.Std.Hash.folder = fun f _ st t -> match t with | Value v -> f st v | Thunk t -> f st (Lazy.force t) let compare_thunk : type a b. (a Ppx_compare_lib.compare) -> (b Ppx_compare_lib.compare) -> (a,b) thunk Ppx_compare_lib.compare = fun f _ t1 t2 -> match t1,t2 with | Value v1, Value v2 -> f v1 v2 | Thunk t1, Value v2 -> f (Lazy.force t1) v2 | Value v1, Thunk t2 -> f v1 (Lazy.force t2) | Thunk t1, Thunk t2 -> f (Lazy.force t1) (Lazy.force t2) type ('a, 'b) t = [%import: ('a, 'b) DAst.t] [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_dAst.mli000066400000000000000000000023731466734233400206570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* template_arity val sexp_of_template_arity : template_arity -> Sexp.t type ('a, 'b) declaration_arity = ('a, 'b) Declarations.declaration_arity val declaration_arity_of_sexp : (Sexp.t -> 'a) -> (Sexp.t -> 'b) -> Sexp.t -> ('a, 'b) declaration_arity val sexp_of_declaration_arity : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b) declaration_arity -> Sexp.t type recarg = Declarations.recarg [@@deriving sexp,yojson,hash,compare] type wf_paths = recarg Rtree.t [@@deriving sexp,yojson,hash,compare] type regular_inductive_arity = Declarations.regular_inductive_arity [@@deriving sexp,yojson,hash,compare] type inductive_arity = Declarations.inductive_arity [@@deriving sexp,yojson,hash,compare] type one_inductive_body = Declarations.one_inductive_body [@@deriving sexp,yojson,hash,compare] (* type set_predicativity = Declarations.set_predicativity * val set_predicativity_of_sexp : Sexp.t -> set_predicativity * val sexp_of_set_predicativity : set_predicativity -> Sexp.t *) (* type engagement = Declarations.engagement * val engagement_of_sexp : Sexp.t -> engagement * val sexp_of_engagement : engagement -> Sexp.t *) type typing_flags = Declarations.typing_flags [@@deriving sexp,yojson,hash,compare] type inline = Declarations.inline [@@deriving sexp,yojson,hash,compare] (* type work_list = Declarations.work_list *) (* type abstr_info = Declarations.abstr_info = { * abstr_ctx : Constr.named_context; * abstr_subst : Univ.Instance.t; * abstr_uctx : Univ.AbstractContext.t; * } * * type cooking_info = Declarations.cooking_info * val sexp_of_cooking_info : cooking_info -> Sexp.t * val cooking_info_of_sexp : Sexp.t -> cooking_info *) type ('a, 'b) pconstant_body = ('a, 'b) Declarations.pconstant_body [@@deriving sexp,yojson,hash,compare] type constant_body = Declarations.constant_body [@@deriving sexp,yojson,hash,compare] (* type record_body = Declarations.record_body * val record_body_of_sexp : Sexp.t -> record_body * val sexp_of_record_body : record_body -> Sexp.t *) type recursivity_kind = Declarations.recursivity_kind [@@deriving sexp,yojson,hash,compare] type mutual_inductive_body = Declarations.mutual_inductive_body [@@deriving sexp,yojson,hash,compare] type rewrite_rule = Declarations.rewrite_rule [@@deriving sexp,yojson,hash,compare] type 'a module_alg_expr = 'a Declarations.module_alg_expr [@@deriving sexp,yojson,hash,compare] type structure_body = Declarations.structure_body [@@deriving sexp,yojson,hash,compare] type module_body = Declarations.module_body [@@deriving sexp,yojson,hash,compare] type module_type_body = Declarations.module_type_body [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_declaremods.ml000066400000000000000000000033031466734233400220670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* env val sexp_of_env : env -> Sexp.t type ('constr, 'types) punsafe_judgment = ('constr, 'types) Environ.punsafe_judgment val punsafe_judgment_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> Sexp.t -> ('constr, 'types) punsafe_judgment val sexp_of_punsafe_judgment : ('constr -> Sexplib.Sexp.t) -> ('types -> Sexplib.Sexp.t) -> ('constr, 'types) punsafe_judgment -> Sexp.t type unsafe_judgment = Environ.unsafe_judgment val unsafe_judgment_of_sexp : Sexp.t -> unsafe_judgment val sexp_of_unsafe_judgment : unsafe_judgment -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_equality.ml000066400000000000000000000025241466734233400214460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* |= _t_get) let to_yojson level = _t_to_yojson (_t_put level) let hash x = hash__t (_t_put x) let hash_fold_t st id = hash_fold__t st (_t_put id) let compare x y = compare__t (_t_put x) (_t_put y) end include Self module Set = Ser_cSet.Make(Evar.Set)(Self) coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_evar.mli000066400000000000000000000024621466734233400207200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* conv_pb val sexp_of_conv_pb : conv_pb -> Sexp.t type evar_constraint = Evd.evar_constraint val evar_constraint_of_sexp : Sexp.t -> evar_constraint val sexp_of_evar_constraint : evar_constraint -> Sexp.t type unsolvability_explanation = Evd.unsolvability_explanation val unsolvability_explanation_of_sexp : Sexp.t -> unsolvability_explanation val sexp_of_unsolvability_explanation : unsolvability_explanation -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_extend.ml000066400000000000000000000041621466734233400211000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* production_position val sexp_of_production_position : production_position -> Sexp.t type production_level = Extend.production_level [@@deriving sexp,yojson,hash,compare] type binder_entry_kind = Extend.binder_entry_kind val binder_entry_kind_of_sexp : Sexp.t -> binder_entry_kind val sexp_of_binder_entry_kind : binder_entry_kind -> Sexp.t type 'lev constr_entry_key_gen = 'lev Extend.constr_entry_key_gen val constr_entry_key_gen_of_sexp : (Sexp.t -> 'lev) -> Sexp.t -> 'lev constr_entry_key_gen val sexp_of_constr_entry_key_gen : ('lev -> Sexp.t) -> 'lev constr_entry_key_gen -> Sexp.t type constr_entry_key = Extend.constr_entry_key val constr_entry_key_of_sexp : Sexp.t -> constr_entry_key val sexp_of_constr_entry_key : constr_entry_key -> Sexp.t type constr_prod_entry_key = Extend.constr_prod_entry_key val constr_prod_entry_key_of_sexp : Sexp.t -> constr_prod_entry_key val sexp_of_constr_prod_entry_key : constr_prod_entry_key -> Sexp.t type simple_constr_prod_entry_key = Extend.simple_constr_prod_entry_key [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_feedback.ml000066400000000000000000000033021466734233400213300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t = fun at -> match at with | Rawwit w -> List [Atom "Rawwit"; sexp_of_genarg_type w] | Glbwit w -> List [Atom "Glbwit"; sexp_of_genarg_type w] | Topwit w -> List [Atom "Topwit"; sexp_of_genarg_type w] let rec argument_type_of_sexp : Sexp.t -> argument_type = fun sexp -> match sexp with | List [Atom "ExtraArg"; Atom tag] -> begin match ArgT.name tag with | None -> raise (Failure "SEXP Exception in argument_type") | Some (ArgT.Any t) -> ArgumentType (ExtraArg t) end | List [Atom "ListArg"; s1] -> let (ArgumentType t) = argument_type_of_sexp s1 in ArgumentType (ListArg t) | List [Atom "OptArg"; s1] -> let (ArgumentType t) = argument_type_of_sexp s1 in ArgumentType (OptArg t) | List [Atom "PairArg"; s1; s2] -> let (ArgumentType t1) = argument_type_of_sexp s1 in let (ArgumentType t2) = argument_type_of_sexp s2 in ArgumentType (PairArg(t1,t2)) | _ -> raise (Failure "SEXP Exception") let hash_fold_abstract_argument_type : type lvl. ('o, lvl) abstract_argument_type Hash.folder = fun st at -> match at with | Rawwit w -> hash_tagged hash_fold_genarg_type st "raw" w | Glbwit w -> hash_tagged hash_fold_genarg_type st "glb" w | Topwit w -> hash_tagged hash_fold_genarg_type st "top" w type ('raw, 'glb, 'top) gen_ser = { raw_ser : 'raw -> Sexp.t ; raw_des : Sexp.t -> 'raw ; raw_hash : 'raw Hash.folder ; raw_compare : 'raw -> 'raw -> int ; glb_ser : 'glb -> Sexp.t ; glb_des : Sexp.t -> 'glb ; glb_hash : 'glb Hash.folder ; glb_compare : 'glb -> 'glb -> int ; top_ser : 'top -> Sexp.t ; top_des : Sexp.t -> 'top ; top_hash : 'top Ppx_hash_lib.Std.Hash.folder ; top_compare : 'top -> 'top -> int } module T2_ = struct type ('a, 'b) t = 'a * 'b [@@deriving hash, compare] end let gen_ser_list : ('raw, 'glb, 'top) gen_ser -> ('raw list, 'glb list, 'top list) gen_ser = fun g -> let open Sexplib.Conv in { raw_ser = sexp_of_list g.raw_ser ; raw_des = list_of_sexp g.raw_des ; raw_hash = Hash.Builtin.hash_fold_list g.raw_hash ; raw_compare = compare_list g.raw_compare ; glb_ser = sexp_of_list g.glb_ser ; glb_des = list_of_sexp g.glb_des ; glb_hash = Hash.Builtin.hash_fold_list g.glb_hash ; glb_compare = compare_list g.glb_compare ; top_ser = sexp_of_list g.top_ser ; top_des = list_of_sexp g.top_des ; top_hash = Hash.Builtin.hash_fold_list g.top_hash ; top_compare = compare_list g.top_compare } let gen_ser_opt : ('raw, 'glb, 'top) gen_ser -> ('raw option, 'glb option, 'top option) gen_ser = fun g -> let open Sexplib.Conv in { raw_ser = sexp_of_option g.raw_ser ; raw_des = option_of_sexp g.raw_des ; raw_hash = Hash.Builtin.hash_fold_option g.raw_hash ; raw_compare = compare_option g.raw_compare ; glb_ser = sexp_of_option g.glb_ser ; glb_des = option_of_sexp g.glb_des ; glb_hash = Hash.Builtin.hash_fold_option g.glb_hash ; glb_compare = compare_option g.glb_compare ; top_ser = sexp_of_option g.top_ser ; top_des = option_of_sexp g.top_des ; top_hash = Hash.Builtin.hash_fold_option g.top_hash ; top_compare = compare_option g.top_compare } let gen_ser_pair : ('raw1, 'glb1, 'top1) gen_ser -> ('raw2, 'glb2, 'top2) gen_ser -> (('raw1 * 'raw2), ('glb1 * 'glb2), ('top1 * 'top2)) gen_ser = fun g1 g2 -> let open Sexplib.Conv in { raw_ser = sexp_of_pair g1.raw_ser g2.raw_ser ; raw_des = pair_of_sexp g1.raw_des g2.raw_des ; raw_hash = T2_.hash_fold_t g1.raw_hash g2.raw_hash ; raw_compare = T2_.compare g1.raw_compare g2.raw_compare ; glb_ser = sexp_of_pair g1.glb_ser g2.glb_ser ; glb_des = pair_of_sexp g1.glb_des g2.glb_des ; glb_hash = T2_.hash_fold_t g1.glb_hash g2.glb_hash ; glb_compare = T2_.compare g1.glb_compare g2.glb_compare ; top_ser = sexp_of_pair g1.top_ser g2.top_ser ; top_des = pair_of_sexp g1.top_des g2.top_des ; top_hash = T2_.hash_fold_t g1.top_hash g2.top_hash ; top_compare = T2_.compare g1.top_compare g2.top_compare } module SerObj = struct type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) gen_ser let sexp_of_gen typ ga = let typ = typ ^ ": " ^ Sexp.to_string (sexp_of_genarg_type ga) in Serlib_base.sexp_of_opaque ~typ let name = "ser_arg" let default _ga = Some { (* raw_ser = (fun _ -> Sexp.(List [Atom "[XXX ser_gen]"; Atom "raw"; sexp_of_genarg_type ga])); *) raw_ser = sexp_of_gen "raw" _ga ; raw_des = (Sexplib.Conv_error.no_matching_variant_found "raw_arg") ; raw_hash = (fun st a -> Hash.fold_int st (Hashtbl.hash a)) ; raw_compare = Stdlib.compare (* glb_ser = (fun _ -> Sexp.(List [Atom "[XXX ser_gen]"; Atom "glb"; sexp_of_genarg_type ga])); *) ; glb_ser = sexp_of_gen "glb" _ga ; glb_des = (Sexplib.Conv_error.no_matching_variant_found "glb_arg") ; glb_hash = (fun st a -> Hash.fold_int st (Hashtbl.hash a)) ; glb_compare = Stdlib.compare (* top_ser = (fun _ -> Sexp.(List [Atom "[XXX ser_gen]"; Atom "top"; sexp_of_genarg_type ga])); *) ; top_ser = sexp_of_gen "top" _ga ; top_des = (Sexplib.Conv_error.no_matching_variant_found "top_arg") ; top_hash = (fun st a -> Hash.fold_int st (Hashtbl.hash a)) ; top_compare = Stdlib.compare } end module SerGen = Register(SerObj) let register_genser ty obj = SerGen.register0 ty obj let rec get_gen_ser_ty : type r g t. (r,g,t) Genarg.genarg_type -> (r,g,t) gen_ser = fun gt -> match gt with | Genarg.ExtraArg _ -> SerGen.obj gt | Genarg.ListArg t -> gen_ser_list (get_gen_ser_ty t) | Genarg.OptArg t -> gen_ser_opt (get_gen_ser_ty t) | Genarg.PairArg(t1, t2) -> gen_ser_pair (get_gen_ser_ty t1) (get_gen_ser_ty t2) let get_gen_ser : type lvl. ('o,lvl) abstract_argument_type -> ('o -> 't) = fun aty -> match aty with | Genarg.Rawwit ty -> (get_gen_ser_ty ty).raw_ser | Genarg.Glbwit ty -> (get_gen_ser_ty ty).glb_ser | Genarg.Topwit ty -> (get_gen_ser_ty ty).top_ser let generic_des : type lvl. ('o,lvl) abstract_argument_type -> Sexp.t -> lvl generic_argument = fun ty s -> match ty with | Genarg.Rawwit w -> GenArg(ty, (get_gen_ser_ty w).raw_des s) | Genarg.Glbwit w -> GenArg(ty, (get_gen_ser_ty w).glb_des s) | Genarg.Topwit w -> GenArg(ty, (get_gen_ser_ty w).top_des s) let hash_fold_generic : type lvl. ('o,lvl) abstract_argument_type -> 'o Ppx_hash_lib.Std.Hash.folder = fun aty -> match aty with | Genarg.Rawwit ty -> (get_gen_ser_ty ty).raw_hash | Genarg.Glbwit ty -> (get_gen_ser_ty ty).glb_hash | Genarg.Topwit ty -> (get_gen_ser_ty ty).top_hash let compare_generic : type lvl. ('o,lvl) abstract_argument_type -> 'o Ppx_compare_lib.compare = fun aty -> match aty with | Genarg.Rawwit ty -> (get_gen_ser_ty ty).raw_compare | Genarg.Glbwit ty -> (get_gen_ser_ty ty).glb_compare | Genarg.Topwit ty -> (get_gen_ser_ty ty).top_compare (* We need to generalize this to use the proper printers for opt *) let mk_sexparg st so = Sexp.List [Atom "GenArg"; st; so] (* XXX: There is still some duplication here in the traversal of g_ty, but we can live with that for now. *) let sexp_of_genarg_val : type a. a generic_argument -> Sexp.t = fun g -> match g with | GenArg (g_ty, g_val) -> mk_sexparg (sexp_of_abstract_argument_type g_ty) (get_gen_ser g_ty g_val) let sexp_of_generic_argument : type a. (a -> Sexp.t) -> a generic_argument -> Sexp.t = fun _level_tag g -> sexp_of_genarg_val g type rgen_argument = RG : 'lvl generic_argument -> rgen_argument let hash_fold_genarg_val : type a. a generic_argument Hash.folder = fun st g -> match g with | GenArg (g_ty, g_val) -> let st = hash_fold_abstract_argument_type st g_ty in hash_fold_generic g_ty st g_val let hash_fold_generic_argument : type a. a Hash.folder -> a generic_argument Hash.folder = fun _level_tag g -> hash_fold_genarg_val g let compare_genarg_val : type a. a generic_argument Ppx_compare_lib.compare = fun g1 g2 -> match g1 with | GenArg (g1_ty, g1_val) -> match g2 with | GenArg (g2_ty, g2_val) -> match Genarg.abstract_argument_type_eq g1_ty g2_ty with | Some Refl -> compare_generic g1_ty g1_val g2_val (* XXX: Technically, we should implement our own compare so ordering works *) | None -> 1 let compare_generic_argument : type a. a Ppx_compare_lib.compare -> a generic_argument Ppx_compare_lib.compare = fun _level_tag g -> compare_genarg_val g let gen_abstype_of_sexp : Sexp.t -> rgen_argument = fun s -> match s with | List [Atom "GenArg"; List [ Atom "Rawwit"; sty]; sobj] -> let (ArgumentType ty) = argument_type_of_sexp sty in RG (generic_des (Rawwit ty) sobj) | List [Atom "GenArg"; List [ Atom "Glbwit"; sty]; sobj] -> let (ArgumentType ty) = argument_type_of_sexp sty in RG (generic_des (Glbwit ty) sobj) | List [Atom "GenArg"; List [ Atom "Topwit"; sty]; sobj] -> let (ArgumentType ty) = argument_type_of_sexp sty in RG (generic_des (Topwit ty) sobj) | _ -> raise (Failure "SEXP Exception in abstype") let generic_argument_of_sexp _lvl sexp : 'a Genarg.generic_argument = let (RG ga) = gen_abstype_of_sexp sexp in Obj.magic ga let rec yojson_to_sexp json = match json with | `String s -> Sexp.Atom s | `List s -> Sexp.List (List.map yojson_to_sexp s) | _ -> raise (Failure "ser_genarg: yojson_to_sexp") let rec sexp_to_yojson sexp : Yojson.Safe.t = match sexp with | Sexp.Atom s -> `String s | List l -> `List (List.map sexp_to_yojson l) let generic_argument_of_yojson lvl json = let sexp = yojson_to_sexp json in Result.Ok (generic_argument_of_sexp lvl sexp) let generic_argument_to_yojson : type a. (a -> Yojson.Safe.t) -> a generic_argument -> Yojson.Safe.t = fun _level_tag g -> sexp_of_generic_argument (fun _ -> Atom "") g |> sexp_to_yojson type 'a generic_argument = 'a Genarg.generic_argument type glob_generic_argument = [%import: Genarg.glob_generic_argument] [@@deriving sexp,yojson,hash,compare] type raw_generic_argument = [%import: Genarg.raw_generic_argument] [@@deriving sexp,yojson,hash,compare] type typed_generic_argument = [%import: Genarg.typed_generic_argument] [@@deriving sexp,yojson,hash,compare] let mk_uniform pin pout phash pcompare = { raw_ser = pin ; raw_des = pout ; raw_hash = phash ; raw_compare = pcompare ; glb_ser = pin ; glb_des = pout ; glb_hash = phash ; glb_compare = pcompare ; top_ser = pin ; top_des = pout ; top_hash = phash ; top_compare = pcompare } let mk_vernac_arg pin pout phash pcompare = { raw_ser = pin ; raw_des = pout ; raw_hash = phash ; raw_compare = pcompare ; glb_ser = Ser_util.Empty.sexp_of_t ; glb_des = Ser_util.Empty.t_of_sexp ; glb_hash = Ser_util.Empty.hash_fold_t ; glb_compare = Ser_util.Empty.compare ; top_ser = Ser_util.Empty.sexp_of_t ; top_des = Ser_util.Empty.t_of_sexp ; top_hash = Ser_util.Empty.hash_fold_t ; top_compare = Ser_util.Empty.compare } module type GenSer0 = sig type t [@@deriving sexp,hash,compare] end module GS0 (M : GenSer0) = struct let genser = mk_uniform M.sexp_of_t M.t_of_sexp M.hash_fold_t M.compare end module GSV (M : GenSer0) = struct let genser = mk_vernac_arg M.sexp_of_t M.t_of_sexp M.hash_fold_t M.compare end module type GenSer = sig type raw [@@deriving sexp,hash,compare] type glb [@@deriving sexp,hash,compare] type top [@@deriving sexp,hash,compare] end module GS (M : GenSer) = struct let genser = { raw_ser = M.sexp_of_raw ; raw_des = M.raw_of_sexp ; raw_hash = M.hash_fold_raw ; raw_compare = M.compare_raw ; glb_ser = M.sexp_of_glb ; glb_des = M.glb_of_sexp ; glb_hash = M.hash_fold_glb ; glb_compare = M.compare_glb ; top_ser = M.sexp_of_top ; top_des = M.top_of_sexp ; top_hash = M.hash_fold_top ; top_compare = M.compare_top } end coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_genarg.mli000066400000000000000000000075361466734233400212350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t) ref *) (* val sexp_of_tacdef_body : (Tacexpr.tacdef_body -> Sexp.t) ref *) (**********************************************************************) (* GenArg *) (**********************************************************************) type rlevel = Genarg.rlevel [@@deriving sexp,yojson,hash,compare] type glevel = Genarg.glevel [@@deriving sexp,yojson,hash,compare] type tlevel = Genarg.tlevel [@@deriving sexp,yojson,hash,compare] type 'a generic_argument = 'a Genarg.generic_argument [@@deriving sexp,yojson,hash,compare] type glob_generic_argument = Genarg.glob_generic_argument [@@deriving sexp,yojson,hash,compare] type raw_generic_argument = Genarg.raw_generic_argument [@@deriving sexp,yojson,hash,compare] type typed_generic_argument = Genarg.typed_generic_argument val typed_generic_argument_of_sexp : Sexp.t -> Genarg.typed_generic_argument val sexp_of_typed_generic_argument : Genarg.typed_generic_argument -> Sexp.t (* Registering serializing functions *) type ('raw, 'glb, 'top) gen_ser = { raw_ser : 'raw -> Sexp.t ; raw_des : Sexp.t -> 'raw ; raw_hash : 'raw Ppx_hash_lib.Std.Hash.folder ; raw_compare : 'raw -> 'raw -> int ; glb_ser : 'glb -> Sexp.t ; glb_des : Sexp.t -> 'glb ; glb_hash : 'glb Ppx_hash_lib.Std.Hash.folder ; glb_compare : 'glb -> 'glb -> int ; top_ser : 'top -> Sexp.t ; top_des : Sexp.t -> 'top ; top_hash : 'top Ppx_hash_lib.Std.Hash.folder ; top_compare : 'top -> 'top -> int } val register_genser : ('raw, 'glb, 'top) Genarg.genarg_type -> ('raw, 'glb, 'top) gen_ser -> unit val gen_ser_pair : ('raw1, 'glb1, 'top1) gen_ser -> ('raw2, 'glb2, 'top2) gen_ser -> (('raw1 * 'raw2), ('glb1 * 'glb2), ('top1 * 'top2)) gen_ser val gen_ser_list : ('raw, 'glb, 'top) gen_ser -> ('raw list, 'glb list, 'top list) gen_ser val mk_uniform : ('t -> Sexp.t) -> (Sexp.t -> 't) -> 't Ppx_hash_lib.Std.Hash.folder -> 't Ppx_compare_lib.compare -> ('t,'t,'t) gen_ser val mk_vernac_arg : ('t -> Sexp.t) -> (Sexp.t -> 't) -> 't Ppx_hash_lib.Std.Hash.folder -> 't Ppx_compare_lib.compare -> ('t,Util.Empty.t,Util.Empty.t) gen_ser module type GenSer0 = sig type t [@@deriving sexp,hash,compare] end module GS0 (M : GenSer0) : sig val genser : (M.t,M.t,M.t) gen_ser end module GSV (M : GenSer0) : sig val genser : (M.t,Util.Empty.t,Util.Empty.t) gen_ser end module type GenSer = sig type raw [@@deriving sexp,hash,compare] type glb [@@deriving sexp,hash,compare] type top [@@deriving sexp,hash,compare] end module GS (M : GenSer) : sig val genser : (M.raw,M.glb,M.top) gen_ser end coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_genintern.ml000066400000000000000000000040751466734233400216050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* glob_sign val sexp_of_glob_sign : glob_sign -> Sexp.t type glob_constr_and_expr = Genintern.glob_constr_and_expr [@@deriving sexp, yojson, hash, compare] type glob_constr_pattern_and_expr = Genintern.glob_constr_pattern_and_expr [@@deriving sexp, yojson, hash, compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_geninterp.ml000066400000000000000000000050251466734233400216030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t -> 'a Glob_term.cast_type * val sexp_of_cast_type : ('a -> Sexp.t) -> 'a Glob_term.cast_type -> Sexp.t * val cast_type_of_yojson : (Yojson.Safe.t -> ('a,string) result ) -> Yojson.Safe.t -> ('a cast_type, string) Result.t * val cast_type_to_yojson : ('a -> Yojson.Safe.t) -> 'a cast_type -> Yojson.Safe.t *) type glob_constraint = Glob_term.glob_constraint [@@deriving sexp,yojson,hash,compare] type existential_name = Glob_term.existential_name [@@deriving sexp,yojson,hash,compare] type cases_pattern = Glob_term.cases_pattern type glob_constr = Glob_term.glob_constr and glob_decl = Glob_term.glob_decl and predicate_pattern = Glob_term.predicate_pattern and tomatch_tuple = Glob_term.tomatch_tuple and tomatch_tuples = Glob_term.tomatch_tuples and cases_clause = Glob_term.cases_clause and cases_clauses = Glob_term.cases_clauses [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_globnames.ml000066400000000000000000000025761466734233400215670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* |= _t_get) let qualid_r_to_yojson level = _t_to_yojson (_t_put level) (* let hash_qualid_r x = hash__t (_t_put x) *) let hash_fold_qualid_r st x = hash_fold__t st (_t_put x) let compare_qualid_r x y = compare__t (_t_put x) (_t_put y) (* qualid: private *) type qualid = [%import: Libnames.qualid] [@@deriving sexp,yojson,hash,compare] module FP = struct type _t = { dirpath : Names.DirPath.t ; basename : Names.Id.t } [@@deriving sexp,yojson,hash,compare] let _t_get { dirpath; basename } = Libnames.make_path dirpath basename let _t_put fp = let dirpath, basename = Libnames.repr_path fp in { dirpath; basename } end open FP type full_path = Libnames.full_path let full_path_of_sexp sexp = _t_get (_t_of_sexp sexp) let sexp_of_full_path qid = sexp_of__t (_t_put qid) let full_path_of_yojson json = Ppx_deriving_yojson_runtime.(_t_of_yojson json >|= _t_get) let full_path_to_yojson level = _t_to_yojson (_t_put level) let hash_full_path x = hash__t (_t_put x) let hash_fold_full_path st x = hash_fold__t st (_t_put x) let compare_full_path x y = compare__t (_t_put x) (_t_put y) coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_libnames.mli000066400000000000000000000024771466734233400215630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t -> 'a hyp_location_expr val sexp_of_hyp_location_expr : ('a -> Sexp.t) -> 'a hyp_location_expr -> Sexp.t type 'id clause_expr = 'id Locus.clause_expr [@@deriving sexp,yojson,hash,compare] type clause = Locus.clause val clause_of_sexp : Sexp.t -> clause val sexp_of_clause : clause -> Sexp.t type clause_atom = Locus.clause_atom val clause_atom_of_sexp : Sexp.t -> clause_atom val sexp_of_clause_atom : clause_atom -> Sexp.t type concrete_clause = Locus.concrete_clause val concrete_clause_of_sexp : Sexp.t -> concrete_clause val sexp_of_concrete_clause : concrete_clause -> Sexp.t type hyp_location = Locus.hyp_location [@@deriving sexp,yojson,hash,compare] type goal_location = Locus.goal_location val goal_location_of_sexp : Sexp.t -> goal_location val sexp_of_goal_location : goal_location -> Sexp.t type simple_clause = Locus.simple_clause val simple_clause_of_sexp : Sexp.t -> simple_clause val sexp_of_simple_clause : simple_clause -> Sexp.t type 'id or_like_first = 'id Locus.or_like_first val or_like_first_of_sexp : (Sexp.t -> 'id) -> Sexp.t -> 'id or_like_first val sexp_of_or_like_first : ('id -> Sexp.t) -> 'id or_like_first -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_ltac_pretype.ml000066400000000000000000000033121466734233400223000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* closure val sexp_of_closure : closure -> Sexp.t type closed_glob_constr = Ltac_pretype.closed_glob_constr [@@deriving sexp,hash,compare] type constr_under_binders = Ltac_pretype.constr_under_binders val constr_under_binders_of_sexp : Sexp.t -> constr_under_binders val sexp_of_constr_under_binders : constr_under_binders -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_mod_subst.ml000066400000000000000000000031201466734233400216010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t) -> 'a substituted -> Sexp.t * val substituted_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a substituted *) coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_namegen.ml000066400000000000000000000025101466734233400212160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* |= _kername_get) let to_yojson kn = _t_to_yojson (_t_put kn) let hash x = hash__t (_t_put x) let hash_fold_t st id = hash_fold__t st (_t_put id) let compare x y = compare__t (_t_put x) (_t_put y) let equal = KerName.equal end module KNmap = Ser_cMap.Make(Names.KNmap)(KerName) module Constant = struct (* Constant.t: private *) type t = [%import: Names.Constant.t] type _t = Constant of KerName.t * KerName.t option [@@deriving sexp,yojson,hash,compare] let _t_put cs = let cu, cc = Constant.(user cs, canonical cs) in if KerName.equal cu cc then Constant (cu, None) else Constant (cu, Some cc) let _t_get = function | Constant (cu, None) -> Constant.make1 cu | Constant (cu, Some cc) -> Constant.make cu cc let t_of_sexp sexp = _t_get (_t_of_sexp sexp) let sexp_of_t dp = sexp_of__t (_t_put dp) let of_yojson json = Ppx_deriving_yojson_runtime.(_t_of_yojson json >|= _t_get) let to_yojson level = _t_to_yojson (_t_put level) let hash x = hash__t (_t_put x) let hash_fold_t st id = hash_fold__t st (_t_put id) let compare x y = compare__t (_t_put x) (_t_put y) end module Cset_env = Ser_cSet.Make(Cset_env)(Constant) module Cmap = Ser_cMap.Make(Cmap)(Constant) module Cmap_env = Ser_cMap.Make(Cmap_env)(Constant) module MutInd = struct (* MutInd.t: private *) module BijectSpec = struct type t = [%import: Names.MutInd.t] type _t = MutInd of KerName.t * KerName.t option [@@deriving sexp,yojson,hash,compare] let of_t cs = let cu, cc = MutInd.(user cs, canonical cs) in if KerName.equal cu cc then MutInd (cu, None) else MutInd (cu, Some cc) let to_t = function | MutInd (cu, None) -> MutInd.make1 cu | MutInd (cu, Some cc) -> MutInd.make cu cc end include SerType.Biject(BijectSpec) end module Mindmap = Ser_cMap.Make(Mindmap)(MutInd) module Mindmap_env = Ser_cMap.Make(Mindmap_env)(MutInd) type 'a tableKey = [%import: 'a Names.tableKey] [@@deriving sexp] type variable = [%import: Names.variable] [@@deriving sexp,yojson,hash,compare] (* Inductive and constructor = public *) module Ind = struct type t = [%import: Names.Ind.t] [@@deriving sexp,yojson,hash,compare] end module Indset_env = Ser_cSet.Make(Indset_env)(Ind) module Indmap_env = Ser_cMap.Make(Indmap_env)(Ind) type inductive = [%import: Names.inductive] [@@deriving sexp,yojson,hash,compare] module Construct = struct type t = [%import: Names.Construct.t] [@@deriving sexp,yojson,hash,compare] end type constructor = [%import: Names.constructor] [@@deriving sexp,yojson,hash,compare] (* Projection: private *) module Projection = struct module Repr = struct module PierceSpec = struct type t = Names.Projection.Repr.t type _t = { proj_ind : inductive ; proj_relevant : bool ; proj_npars : int ; proj_arg : int ; proj_name : Label.t } [@@deriving sexp,yojson,hash,compare] end include SerType.Pierce(PierceSpec) end module PierceSpec = struct type t = [%import: Names.Projection.t] type _t = Repr.t * bool [@@deriving sexp,yojson,hash,compare] end include SerType.Pierce(PierceSpec) end module GlobRef = struct type t = [%import: Names.GlobRef.t] [@@deriving sexp,yojson,hash,compare] end type lident = [%import: Names.lident] [@@deriving sexp,yojson,hash,compare] type lname = [%import: Names.lname] [@@deriving sexp,yojson,hash,compare] type lstring = [%import: Names.lstring] [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_names.mli000066400000000000000000000066641466734233400210760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t -> 'a tableKey val sexp_of_tableKey : ('a -> Sexp.t) -> 'a tableKey -> Sexp.t type variable = Names.variable [@@deriving sexp, yojson, hash, compare] type inductive = Names.inductive [@@deriving sexp, yojson, hash, compare] type constructor = Names.constructor [@@deriving sexp, yojson, hash, compare] module Projection : sig include SerType.SJHC with type t = Projection.t module Repr : sig include SerType.SJHC with type t = Projection.Repr.t end end module GlobRef : SerType.SJHC with type t = Names.GlobRef.t type lident = Names.lident [@@deriving sexp,yojson,hash,compare] type lname = Names.lname [@@deriving sexp,yojson,hash,compare] type lstring = Names.lstring [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_nametab.ml000066400000000000000000000024271466734233400212220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* parenRelation * val sexp_of_parenRelation : parenRelation -> Sexp.t * * type precedence = Notation_gram.precedence * * val precedence_of_sexp : Sexp.t -> precedence * val sexp_of_precedence : precedence -> Sexp.t * * type tolerability = Notation_gram.tolerability * * val tolerability_of_sexp : Sexp.t -> tolerability * val sexp_of_tolerability : tolerability -> Sexp.t *) type grammar_constr_prod_item = Notation_gram.grammar_constr_prod_item val grammar_constr_prod_item_of_sexp : Sexp.t -> grammar_constr_prod_item val sexp_of_grammar_constr_prod_item : grammar_constr_prod_item -> Sexp.t type notation_grammar = Notation_gram.notation_grammar val notation_grammar_of_sexp : Sexp.t -> notation_grammar val sexp_of_notation_grammar : notation_grammar -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_notation_term.ml000066400000000000000000000043111466734233400224670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* case_info_pattern val sexp_of_case_info_pattern : case_info_pattern -> Sexp.t type constr_pattern = Pattern.constr_pattern [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_pp.ml000066400000000000000000000051141466734233400202260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp_empty | Ppcmd_string s -> Pp_string s | Ppcmd_glue l -> Pp_glue (List.map of_t l) | Ppcmd_box (bt,d) -> Pp_box(bt, of_t d) | Ppcmd_tag (t,d) -> Pp_tag(t, of_t d) | Ppcmd_print_break (n,m) -> Pp_print_break(n,m) | Ppcmd_force_newline -> Pp_force_newline | Ppcmd_comment s -> Pp_comment s let rec to_t (d : _t) : t = unrepr (match d with | Pp_empty -> Ppcmd_empty | Pp_string s -> Ppcmd_string s | Pp_glue l -> Ppcmd_glue (List.map to_t l) | Pp_box (bt,d) -> Ppcmd_box(bt, to_t d) | Pp_tag (t,d) -> Ppcmd_tag(t, to_t d) | Pp_print_break (n,m) -> Ppcmd_print_break(n,m) | Pp_force_newline -> Ppcmd_force_newline | Pp_comment s -> Ppcmd_comment s) end include SerType.Biject(P) type doc_view = [%import: Pp.doc_view] [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_pp.mli000066400000000000000000000024521466734233400204010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ppbox val sexp_of_ppbox : ppbox -> Sexp.t type ppcut = Ppextend.ppcut val ppcut_of_sexp : Sexp.t -> ppcut val sexp_of_ppcut : ppcut -> Sexp.t (* type unparsing = Ppextend.unparsing * val unparsing_of_sexp : Sexp.t -> unparsing * val sexp_of_unparsing : unparsing -> Sexp.t *) type unparsing_rule = Ppextend.unparsing_rule val unparsing_rule_of_sexp : Sexp.t -> unparsing_rule val sexp_of_unparsing_rule : unparsing_rule -> Sexp.t type notation_printing_rules = Ppextend.notation_printing_rules val notation_printing_rules_of_sexp : Sexp.t -> notation_printing_rules val sexp_of_notation_printing_rules : notation_printing_rules -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_pretype_errors.ml000066400000000000000000000052271466734233400227000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* NotClean (e, ee, c) | ConversionFailed (_, c1, c2) -> ConversionFailed (ee, c1, c2) | IncompatibleInstances (_, e, c1, c2) -> IncompatibleInstances (ee, e, c1, c2) | InstanceNotSameType (e, _, t1, t2) -> InstanceNotSameType (e, ee, t1, t2) | CannotSolveConstraint (e, ue) -> CannotSolveConstraint (e, (filter_ue ue)) | ue -> ue let sexp_of_unification_error ue = filter_ue ue |> sexp_of_unification_error type position = [%import: Pretype_errors.position] [@@deriving sexp] type position_reporting = [%import: Pretype_errors.position_reporting] [@@deriving sexp] type subterm_unification_error = [%import: Pretype_errors.subterm_unification_error] [@@deriving sexp] type type_error = [%import: Pretype_errors.type_error] [@@deriving sexp] type pretype_error = [%import: Pretype_errors.pretype_error] [@@deriving sexp] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_pretype_errors.mli000066400000000000000000000040451466734233400230460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unification_error val sexp_of_unification_error : unification_error -> Sexp.t type position = Pretype_errors.position val position_of_sexp : Sexp.t -> position val sexp_of_position : position -> Sexp.t type position_reporting = Pretype_errors.position_reporting val position_reporting_of_sexp : Sexp.t -> position_reporting val sexp_of_position_reporting : position_reporting -> Sexp.t type subterm_unification_error = Pretype_errors.subterm_unification_error val subterm_unification_error_of_sexp : Sexp.t -> subterm_unification_error val sexp_of_subterm_unification_error : subterm_unification_error -> Sexp.t type pretype_error = Pretype_errors.pretype_error val pretype_error_of_sexp : Sexp.t -> pretype_error val sexp_of_pretype_error : pretype_error -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_printer.ml000066400000000000000000000024061466734233400212730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'b) (x : 'a SList.t) : 'b SList.t = Obj.magic (_map f (Obj.magic x)) coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_safe_typing.ml000066400000000000000000000055661466734233400221320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a) (x : Sexp.t) : 'a effect_entry = let open Sexp in match x with | Atom "PureEntry" -> Obj__magic PureEntry | Atom "EffectEntry" -> Obj__magic EffectEntry | _ -> Sexplib.Conv_error.no_variant_match () *) type global_declaration = [%import: Safe_typing.global_declaration] [@@deriving sexp] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_safe_typing.mli000066400000000000000000000027241466734233400222740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* global_declaration val sexp_of_global_declaration : global_declaration -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_sorts.ml000066400000000000000000000056421466734233400207670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t val sexp_of_t : t -> Sexp.t type 'c p = 'c Tok.p val p_of_sexp : (Sexp.t -> 'c) -> Sexp.t -> 'c p val sexp_of_p : ('c -> Sexp.t) -> 'c p -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_type_errors.ml000066400000000000000000000042441466734233400221670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* guard_error val sexp_of_guard_error : guard_error -> Sexp.t type ('c,'t) pcant_apply_bad_type = ('c, 't) Type_errors.pcant_apply_bad_type val pcant_apply_bad_type_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> Sexp.t -> ('constr, 'types) pcant_apply_bad_type val sexp_of_pcant_apply_bad_type : ('constr -> Sexp.t) -> ('types -> Sexp.t) -> ('constr, 'types) pcant_apply_bad_type -> Sexp.t type ('c, 't, 'r) ptype_error = ('c, 't, 'r) Type_errors.ptype_error val ptype_error_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> (Sexp.t -> 'r) -> Sexp.t -> ('constr, 'types, 'r) ptype_error val sexp_of_ptype_error : ('constr -> Sexp.t) -> ('types -> Sexp.t) -> ('r -> Sexp.t) -> ('constr, 'types, 'r) ptype_error -> Sexp.t type type_error = Type_errors.type_error val type_error_of_sexp : Sexp.t -> type_error val sexp_of_type_error : type_error -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_typeclasses.ml000066400000000000000000000025561466734233400221550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* |= _t_get) let to_yojson level = _t_to_yojson (_t_put level) let hash_fold_t st i = Ppx_hash_lib.Std.Hash.Builtin.hash_fold_int64 st (Uint63.to_int64 i) let compare i1 i2 = Ppx_compare_lib.Builtin.compare_int64 (Uint63.to_int64 i1) (Uint63.to_int64 i2) coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_univ.ml000066400000000000000000000060751466734233400205770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* univ_constraint val sexp_of_univ_constraint : univ_constraint -> Sexp.t module Constraints : SerType.SJHC with type t = Univ.Constraints.t module ContextSet : SerType.SJHC with type t = Univ.ContextSet.t type 'a in_universe_context_set = 'a Univ.in_universe_context_set val in_universe_context_set_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a in_universe_context_set val sexp_of_in_universe_context_set : ('a -> Sexp.t) -> 'a in_universe_context_set -> Sexp.t coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_univNames.ml000066400000000000000000000027551466734233400215640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* |= _instance_get) let to_yojson level = _t_to_yojson (_instance_put level) let hash i = hash__t (Instance (UVars.Instance.to_array i)) let hash_fold_t st i = hash_fold__t st (Instance (UVars.Instance.to_array i)) let compare i1 i2 = compare__t (Instance (UVars.Instance.to_array i1)) (Instance (UVars.Instance.to_array i2)) end module UContext = struct module I = struct type t = UVars.UContext.t type _t = (Names.Name.t array * Names.Name.t array) * (Instance.t * Constraints.t) [@@deriving sexp,yojson,hash,compare] let to_t (un, cs) = UVars.UContext.make un cs let of_t uc = UVars.UContext.(names uc, (instance uc, constraints uc)) end include SerType.Biject(I) end module AbstractContext = struct let hash_fold_array = hash_fold_array_frozen module ACPierceDef = struct type t = UVars.AbstractContext.t type _t = (Names.Name.t array * Names.Name.t array) * Constraints.t [@@deriving sexp,yojson,hash,compare] end include SerType.Pierce(ACPierceDef) end type 'a in_universe_context = [%import: 'a UVars.in_universe_context] [@@deriving sexp] type 'a puniverses = [%import: 'a UVars.puniverses] [@@deriving sexp, yojson, hash, compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_uvars.mli000066400000000000000000000034651466734233400211270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t -> 'a in_universe_context val sexp_of_in_universe_context : ('a -> Sexp.t) -> 'a in_universe_context -> Sexp.t type 'a puniverses = 'a * Instance.t [@@deriving sexp,yojson,hash,compare] coq-serapi-8.20.0-0.20.0/serlib_8_20/ser_vernacexpr.ml000066400000000000000000000255771466734233400220030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sexp.t val opaque_of_sexp : typ:string -> Sexp.t -> 'a val opaque_of_yojson : typ:string -> Yojson.Safe.t -> ('a, string) Result.t val opaque_to_yojson : typ:string -> 'a -> Yojson.Safe.t val hash_opaque : typ:string -> 'a -> Ppx_hash_lib.Std.Hash.hash_value val hash_fold_opaque : typ:string -> Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state val compare_opaque : typ:string -> 'a -> 'a -> int coq-serapi-8.20.0-0.20.0/serlib_8_20/serlib_init.ml000066400000000000000000000027531466734233400212470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit coq-serapi-8.20.0-0.20.0/serlib_extra/000077500000000000000000000000001466734233400170565ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/serlib_extra/dune000066400000000000000000000004311466734233400177320ustar00rootroot00000000000000(library (name serlib_extra) (public_name coq-serapi.serlib_extra) (synopsis "Serialization Library for Coq (Extra / Deprecated)") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare ppx_deriving_yojson)) (libraries coq-core.stm sexplib coq-serapi.serlib)) coq-serapi-8.20.0-0.20.0/serlib_extra/ser_coqargs.ml000066400000000000000000000026131466734233400217220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* set_impredicative_set:bool -> disallow_sprop:bool -> ml_path:string list -> load_path:Loadpath.vo_path list -> rload_path:Loadpath.vo_path list -> quick:bool -> in_file:string -> indices_matter:bool -> omit_loc:bool -> omit_att:bool -> exn_on_opaque:bool -> omit_env:bool -> coq_path:string -> async:string option -> async_workers:int -> error_recovery:bool -> Stm.doc * Stateid.t coq-serapi-8.20.0-0.20.0/sertop/dune000066400000000000000000000013361466734233400165700ustar00rootroot00000000000000(library (name sertop) (public_name coq-serapi.sertop_v8_12) (modules :standard \ sertop_bin sercomp sertok sername) (preprocess (staged_pps ppx_import ppx_sexp_conv)) (libraries findlib.dynload cmdliner serapi coq-serapi.serlib coq-serapi.serlib.ltac coq-serapi.coq serlib_extra)) (executables (public_names sertop sercomp sertok sername) (names sertop_bin sercomp sertok sername) (modules sertop_bin sercomp sertok sername) (preprocess (staged_pps ppx_import ppx_sexp_conv)) (link_flags -linkall) (libraries sertop)) (rule (targets ser_version.ml) (action (write-file %{targets} "let ser_git_version = \"%{version:coq-serapi}\";;"))) (install (section share_root) (files (sertop.el as emacs/site-lisp/sertop.el))) coq-serapi-8.20.0-0.20.0/sertop/js_sexp_printer.ml000066400000000000000000000105671466734233400214700ustar00rootroot00000000000000(** Emilio J. Gallego Arias: Code below is adapted from Jane Street's sexplib, licence is: The MIT License Copyright (c) 2005--2024 Jane Street Group, LLC opensource-contacts@janestreet.com Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. *) open Format open Sexplib open Sexp let must_escape str = let len = String.length str in len = 0 || let rec loop ix = match str.[ix] with | '"' | '(' | ')' | '[' | ']' | ';' | '\\' | '\''-> true (* Avoid unquoted comma at the beggining of the string *) | ',' -> ix = 0 || loop (ix - 1) | '|' -> ix > 0 && let next = ix - 1 in str.[next] = '#' || loop next | '#' -> ix > 0 && let next = ix - 1 in str.[next] = '|' || loop next | '\000' .. '\032' -> true | '\248' .. '\255' -> true | _ -> ix > 0 && loop (ix - 1) in loop (len - 1) (* XXX: Be faithful to UTF-8 *) let st_escaped (s : string) = let sget = String.unsafe_get in let open Bytes in let n = ref 0 in for i = 0 to String.length s - 1 do n := !n + (match sget s i with | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 | ' ' .. '~' -> 1 (* UTF-8 are valid between \033 -- \247 *) | '\000' .. '\032' -> 4 | '\248' .. '\255' -> 4 | _ -> 1) done; if !n = String.length s then Bytes.of_string s else begin let s' = create !n in n := 0; for i = 0 to String.length s - 1 do begin match sget s i with | ('\"' | '\\') as c -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c | '\n' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n' | '\t' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't' | '\r' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r' | '\b' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b' | (' ' .. '~') as c -> unsafe_set s' !n c (* Valid UTF-8 are valid between \033 -- \247 *) | '\000' .. '\032' | '\248' .. '\255' as c -> let a = Char.code c in unsafe_set s' !n '\\'; incr n; unsafe_set s' !n (Char.chr (48 + a / 100)); incr n; unsafe_set s' !n (Char.chr (48 + (a / 10) mod 10)); incr n; unsafe_set s' !n (Char.chr (48 + a mod 10)); | c -> unsafe_set s' !n c end; incr n done; s' end let esc_str (str : string) = let open Bytes in let estr = st_escaped str in let elen = length estr in let res = create (elen + 2) in blit estr 0 res 1 elen; set res 0 '"'; set res (elen + 1) '"'; to_string res let sertop_maybe_esc_str str = if must_escape str then esc_str str else str let rec pp_sertop_internal may_need_space ppf = function | Atom str -> let str' = sertop_maybe_esc_str str in let new_may_need_space = str' == str in if may_need_space && new_may_need_space then pp_print_string ppf " "; pp_print_string ppf str'; new_may_need_space | List (h :: t) -> pp_print_string ppf "("; let may_need_space = pp_sertop_internal false ppf h in pp_sertop_rest may_need_space ppf t; false | List [] -> pp_print_string ppf "()"; false and pp_sertop_rest may_need_space ppf = function | h :: t -> let may_need_space = pp_sertop_internal may_need_space ppf h in pp_sertop_rest may_need_space ppf t | [] -> pp_print_string ppf ")" let pp_sertop ppf sexp = ignore (pp_sertop_internal false ppf sexp) coq-serapi-8.20.0-0.20.0/sertop/js_sexp_printer.mli000066400000000000000000000024031466734233400216270ustar00rootroot00000000000000(** Emilio J. Gallego Arias: Code below is adapted from Jane Street's sexplib, licence is: The MIT License Copyright (c) 2005--2024 Jane Street Group, LLC opensource-contacts@janestreet.com Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. *) val pp_sertop : Format.formatter -> Sexplib.Sexp.t -> unit coq-serapi-8.20.0-0.20.0/sertop/sercomp.ml000066400000000000000000000137441466734233400177220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* begin let in_strm = Gramlib.Stream.of_channel in_chan in let in_pa = Pcoq.Parsable.make ~loc:(Loc.initial (InFile { dirpath = None; file = in_file} )) in_strm in try while true do let doc, sid = !stt in let east = match Stm.parse_sentence ~doc ~entry:Pvernac.main_entry sid in_pa with | Some east -> east | None -> raise End_of_input in stt := process ~doc ~sid east done; !stt with End_of_input -> !stt end | I_sexp -> begin try while true; do let line = input_line in_chan in let doc, sid = !stt in if String.trim line <> "" then let sxp = Sexplib.Sexp.of_string line in let ast = Serlib.Ser_vernacexpr.vernac_control_of_sexp sxp in stt := process ~doc ~sid ast done; !stt with End_of_file -> !stt end let process_vernac ~mode ~pp ~doc ~sid ast = let open Format in let doc, n_st, tip = Stm.add ~doc ~ontop:sid false ast in if tip <> NewAddTip then CErrors.user_err ?loc:ast.loc Pp.(str "fatal, got no `NewTip`"); let open Sertop.Sertop_arg in let () = match mode with | C_env -> () | C_vo -> () | C_check -> () | C_parse -> () | C_stats -> Sertop.Sercomp_stats.do_stats ast | C_print -> printf "@[%a@]@\n%!" Pp.pp_with Ppvernac.(pr_vernac ast) | C_sexp -> printf "@[%a@]@\n%!" pp (Serlib.Ser_vernacexpr.sexp_of_vernac_control ast) in doc, n_st let close_document ~pp ~mode ~doc ~in_file ~pstate = let open Sertop.Sertop_arg in match mode with | C_parse -> () | C_sexp -> () | C_print -> () | C_stats -> Sertop.Sercomp_stats.print_stats () | C_check -> let _doc = Stm.join ~doc in Serapi.Serapi_doc.check_pending_proofs ~pstate | C_env -> let _doc = Stm.join ~doc in Serapi.Serapi_doc.check_pending_proofs ~pstate; Format.printf "@[%a@]@\n%!" pp Serlib.Ser_environ.(sexp_of_env Global.(env ())) | C_vo -> Serapi.Serapi_doc.save_vo ~doc ~pstate ~in_file () (* Command line processing *) let sercomp_version = Sertop.Ser_version.ser_git_version let sercomp_man = [ `S "DESCRIPTION"; `P "Experimental Coq compiler with serialization and deserialization support."; `S "USAGE"; `P "To serialize `fs/fun.v` with logical path `Funs`:"; `Pre "sercomp -Q fs,Funs --input=vernac --mode=sexp fs/fun.v > fs/fun.sexp"; `P "To deserialize and check `fs/fun.sexp` with logical path `Funs`:"; `Pre "sercomp -Q fs,Funs --input=sexp --mode=check fs/fun.sexp"; `P "To generate `fs/fun.vo` from `fs/fun.sexp` with logical path `Funs`:"; `Pre "sercomp -Q fs,Funs --input=sexp --mode=vo fs/fun.sexp"; `P "See the documentation on the project's webpage for more information." ] let sercomp_doc = "sercomp Coq Compiler" open Cmdliner let driver input mode debug set_impredicative_set disallow_sprop indices_matter printer async async_workers error_recovery quick coq_path ml_path load_path rload_path in_file omit_loc omit_att omit_env exn_on_opaque = (* closures *) let pp = Sertop.Sertop_ser.select_printer printer in let process = process_vernac ~mode ~pp in (* initialization *) let doc, sid = Sertop.Comp_common.create_document ~debug ~set_impredicative_set ~disallow_sprop ~ml_path ~load_path ~rload_path ~quick ~in_file ~indices_matter ~omit_loc ~omit_att ~exn_on_opaque ~omit_env ~coq_path ~async ~async_workers ~error_recovery in (* main loop *) let in_chan = open_in in_file in let doc, _sid = input_doc ~input ~in_file ~in_chan ~process ~doc ~sid in let pstate = match Stm.state_of_id ~doc sid with | Valid (Some { Vernacstate.interp = { lemmas ; _ }; _ }) -> lemmas | _ -> None in let () = close_document ~pp ~mode ~doc ~in_file ~pstate in () let main () = let input_file = let doc = "Input file." in Arg.(required & pos 0 (some string) None & info [] ~docv:("FILE") ~doc) in let sercomp_cmd = let open Sertop.Sertop_arg in let term = Term.(const driver $ comp_input $ comp_mode $ debug $ set_impredicative_set $ disallow_sprop $ indices_matter $ printer $ async $ async_workers $ error_recovery $ quick $ prelude $ ml_include_path $ load_path $ rload_path $ input_file $ omit_loc $ omit_att $ omit_env $ exn_on_opaque ) in let info = Cmd.info "sercomp" ~version:sercomp_version ~doc:sercomp_doc ~man:sercomp_man in Cmd.v info term in try exit (Cmd.eval ~catch:false sercomp_cmd) with exn -> let (e, info) = Exninfo.capture exn in Sertop.Comp_common.fatal_exn e info let _ = main () coq-serapi-8.20.0-0.20.0/sertop/sercomp_stats.ml000066400000000000000000000140331466734233400211300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let open Vernacexpr in let incS ?loc f = Option.cata (fun loc -> let n_lines = Loc.(loc.line_nb_last - loc.line_nb + 1) in Format.printf "@[Adding %d lines@]@\n%!" n_lines; f + n_lines) f loc in match expr with (* Definition *) | VernacSynPure (VernacDefinition (_,_,_) | VernacFixpoint (_,_) | VernacInductive (_,_) | VernacCoFixpoint (_,_)) | VernacSynterp (VernacNotation (_,_)) -> stats.specs <- incS ?loc stats.specs (* Proofs *) | VernacSynPure (VernacStartTheoremProof (_,_)) -> stats.specs <- incS ?loc stats.specs; Option.iter (fun loc -> proof_loc := Some Loc.(loc.line_nb_last)) loc | VernacSynPure (VernacProof (_,_)) -> () (* XXX: Should we use the +1 rule here, what happens for proofs: Proof. exact: L. Qed. *) | VernacSynPure (VernacEndProof _) -> Option.iter (fun ll -> Option.iter (fun loc -> stats.proofs <- stats.proofs + (Loc.(loc.line_nb) - ll) + 1 ) loc ) !proof_loc; proof_loc := None (* This is tricky.. *) (* This is Ltac := ... *) | VernacSynterp (VernacExtend ({ Vernacexpr.ext_entry = "VernacDeclareTacticDefinition"; _ },_)) -> stats.proofs <- incS ?loc stats.proofs; | _ -> if Option.is_empty !proof_loc then stats.misc <- incS ?loc stats.misc (* match vrn with | VernacLoad (_,_) -> (??) | VernacTime _ -> (??) | VernacRedirect (_,_) -> (??) | VernacTimeout (_,_) -> (??) | VernacFail _ -> (??) | VernacError _ -> (??) | VernacSyntaxExtension (_,_) -> (??) | VernacOpenCloseScope (_,_) -> (??) | VernacDelimiters (_,_) -> (??) | VernacBindScope (_,_) -> (??) | VernacInfix (_,_,_,_) -> (??) | VernacNotationAddFormat (_,_,_) -> (??) | VernacStartTheoremProof (_,_,_) -> (??) | VernacExactProof _ -> (??) | VernacAssumption (_,_,_) -> (??) | VernacScheme _ -> (??) | VernacCombinedScheme (_,_) -> (??) | VernacUniverse _ -> (??) | VernacConstraint _ -> (??) | VernacBeginSection _ -> (??) | VernacEndSegment _ -> (??) | VernacRequire (_,_,_) -> (??) | VernacImport (_,_) -> (??) | VernacCanonical _ -> (??) | VernacCoercion (_,_,_,_) -> (??) | VernacIdentityCoercion (_,_,_,_) -> (??) | VernacNameSectionHypSet (_,_) -> (??) | VernacInstance (_,_,_,_,_) -> (??) | VernacContext _ -> (??) | VernacDeclareInstances (_,_) -> (??) | VernacDeclareClass _ -> (??) | VernacDeclareModule (_,_,_,_) -> (??) | VernacDefineModule (_,_,_,_,_) -> (??) | VernacDeclareModuleType (_,_,_,_) -> (??) | VernacInclude _ -> (??) | VernacSolveExistential (_,_) -> (??) | VernacAddLoadPath (_,_,_) -> (??) | VernacRemoveLoadPath _ -> (??) | VernacAddMLPath (_,_) -> (??) | VernacDeclareMLModule _ -> (??) | VernacChdir _ -> (??) | VernacWriteState _ -> (??) | VernacRestoreState _ -> (??) | VernacResetName _ -> (??) | VernacResetInitial -> (??) | VernacBack _ -> (??) | VernacBackTo _ -> (??) | VernacCreateHintDb (_,_) -> (??) | VernacRemoveHints (_,_) -> (??) | VernacHints (_,_,_) -> (??) | VernacSyntacticDefinition (_,_,_,_) -> (??) | VernacDeclareImplicits (_,_) -> (??) | VernacArguments (_,_,_,_) -> (??) | VernacArgumentsScope (_,_) -> (??) | VernacReserve _ -> (??) | VernacGeneralizable _ -> (??) | VernacSetOpacity _ -> (??) | VernacSetStrategy _ -> (??) | VernacUnsetOption _ -> (??) | VernacSetOption (_,_) -> (??) | VernacAddOption (_,_) -> (??) | VernacRemoveOption (_,_) -> (??) | VernacMemOption (_,_) -> (??) | VernacPrintOption _ -> (??) | VernacCheckMayEval (_,_,_) -> (??) | VernacGlobalCheck _ -> (??) | VernacDeclareReduction (_,_) -> (??) | VernacPrint _ -> (??) | VernacSearch (_,_,_) -> (??) | VernacLocate _ -> (??) | VernacRegister (_,_) -> (??) | VernacComments _ -> (??) | VernacStm _ -> (??) | VernacAbort _ -> (??) | VernacAbortAll -> (??) | VernacRestart -> (??) | VernacUndo _ -> (??) | VernacUndoTo _ -> (??) | VernacBacktrack (_,_,_) -> (??) | VernacFocus _ -> (??) | VernacUnfocus -> (??) | VernacUnfocused -> (??) | VernacBullet _ -> (??) | VernacProgram _ -> (??) | VernacSubproof _ -> (??) | VernacEndSubproof -> (??) | VernacShow _ -> (??) | VernacCheckGuard -> (??) | VernacProofMode _ -> (??) | VernacToplevelControl _ -> (??) | VernacExtend (_,_) -> (??) | VernacPolymorphic (_,_) -> (??) | VernacLocal (_,_) -> (??) *) let print_stats () = Format.printf "Statistics:@\nSpecs: %d@\nProofs: %d@\nMisc: %d@\n%!" stats.specs stats.proofs stats.misc coq-serapi-8.20.0-0.20.0/sertop/sercomp_stats.mli000066400000000000000000000025521466734233400213040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit (** [do_stats ast] update stats over processed Asts *) val print_stats : unit -> unit (** [print_stats ()] print stats to stdout *) coq-serapi-8.20.0-0.20.0/sertop/sername.ml000066400000000000000000000133601466734233400176760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "" then process ~doc ~sid line done with End_of_file -> () let str_pp_obj env sigma fmt (obj : Serapi.Serapi_protocol.coq_object) : unit = Format.fprintf fmt "%a" Pp.pp_with (Serapi.Serapi_protocol.gen_pp_obj env sigma obj) let context_of_st m = match m with | Stm.Valid (Some { Vernacstate.interp = { lemmas = Some pstate; _ } ; _} ) -> Vernacstate.LemmaStack.with_top pstate ~f:Declare.Proof.get_current_context | _ -> let env = Global.env () in Evd.from_env env, env let process_line ~pp ~str_pp ~de_bruijn ~body ~doc ~sid line = let open Serapi.Serapi_protocol in let st = Stm.state_of_id ~doc sid in let sigma, env = context_of_st st in let info = QueryUtil.info_of_id env line in let def = if body then fst info else snd info in match def with | [CoqConstr def_term] -> let evd = Evd.from_env env in let edef_term = EConstr.of_constr def_term in let gdef_term = Detyping.detype Detyping.Now Names.Id.Set.empty env evd edef_term in Format.pp_set_margin Format.std_formatter 100000; Format.printf "%s: %!" line; if str_pp then Format.fprintf Format.std_formatter "\"@[%a@]\" %!" (str_pp_obj env sigma) (CoqConstr def_term); if de_bruijn then Format.printf "@[%a@] %!" pp (Serlib.Ser_constr.sexp_of_constr def_term); Format.printf "@[%a@]@\n%!" pp (Serlib.Ser_glob_term.sexp_of_glob_constr gdef_term) | _ -> () let close_document ~doc ~pstate = let _doc = Stm.join ~doc in Serapi.Serapi_doc.check_pending_proofs ~pstate let sername_version = Sertop.Ser_version.ser_git_version let sername_man = [ `S "DESCRIPTION"; `P "Experimental Coq name serializer."; `S "USAGE"; `P "To serialize names listed in `names.txt` in module `Funs.mod`:"; `Pre "sername -Q fs,Funs --require-lib=Funs.mod names.txt"; `P "See the documentation on the project's webpage for more information." ] let sername_doc = "sername Coq tool" (* EJGA: XXX process as regular require at create doc time... *) let do_require ~doc ~sid ~require_lib ~in_file = let sent = Printf.sprintf "Require %s." require_lib in let in_strm = Gramlib.Stream.of_string sent in let in_pa = Pcoq.Parsable.make ~loc:(Loc.initial (InFile { dirpath = None; file = in_file})) in_strm in match Stm.parse_sentence ~doc ~entry:Pvernac.main_entry sid in_pa with | Some ast -> let doc, sid, tip = Stm.add ~doc ~ontop:sid false ast in if tip <> NewAddTip then CErrors.user_err ?loc:ast.loc Pp.(str "fatal, got no `NewTip`"); doc, sid | None -> assert false open Cmdliner let driver debug printer set_impredicative_set disallow_sprop async async_workers error_recovery quick coq_path ml_path load_path rload_path require_lib str_pp de_bruijn body in_file omit_loc omit_att omit_env exn_on_opaque indices_matter = (* closures *) let pp = Sertop.Sertop_ser.select_printer printer in let process = process_line ~pp ~str_pp ~de_bruijn ~body in (* initialization *) let doc, sid = Sertop.Comp_common.create_document ~debug ~set_impredicative_set ~disallow_sprop ~ml_path ~load_path ~rload_path ~quick ~in_file ~indices_matter ~omit_loc ~omit_att ~exn_on_opaque ~omit_env ~coq_path ~async ~async_workers ~error_recovery in let doc, sid = Option.cata (fun require_lib -> do_require ~doc ~sid ~require_lib ~in_file) (doc, sid) require_lib in (* main loop *) let in_chan = open_in in_file in let () = input_doc ~in_chan ~process ~doc ~sid in (* XX *) let pstate = match Stm.state_of_id ~doc sid with | Stm.Valid (Some { Vernacstate.interp = { lemmas; _ }; _ }) -> lemmas | _ -> None in let () = close_document ~doc ~pstate in () let main () = let input_file = let doc = "Input file." in Arg.(required & pos 0 (some string) None & info [] ~docv:("FILE") ~doc) in let sername_cmd = let open Sertop.Sertop_arg in let term = Term.(const driver $ debug $ printer $ set_impredicative_set $ disallow_sprop $ async $ async_workers $ error_recovery $ quick $ prelude $ ml_include_path $ load_path $ rload_path $ require_lib $ str_pp $ de_bruijn $ body $ input_file $ omit_loc $ omit_att $ omit_env $ exn_on_opaque $ indices_matter ) in let info = Cmd.info "sername" ~version:sername_version ~doc:sername_doc ~man:sername_man in Cmd.v info term in try exit (Cmd.eval ~catch:false sername_cmd) with exn -> let (e, info) = Exninfo.capture exn in Sertop.Comp_common.fatal_exn e info let _ = main () coq-serapi-8.20.0-0.20.0/sertop/sertok.ml000066400000000000000000000131731466734233400175550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ast | None -> raise End_of_input in let begin_line, begin_char, end_char = match ast.loc with | Some lc -> lc.line_nb, lc.bp, lc.ep | None -> raise End_of_input in let istr = Bytes.sub_string in_bytes begin_char (end_char - begin_char) in let l_post_st = CLexer.Lexer.State.get () in let sstr = Gramlib.Stream.of_string istr in try CLexer.Lexer.State.set l_pre_st; let lex = CLexer.Lexer.tok_func sstr in let sen = Sertop.Sertop_ser.Sentence (stream_tok 0 [] lex source begin_line begin_char) in CLexer.Lexer.State.set l_post_st; printf "@[%a@]@\n%!" pp (Sertop.Sertop_ser.sexp_of_sentence sen); let doc, n_st, tip = Stm.add ~doc ~ontop:sid false ast in if tip <> NewAddTip then CErrors.user_err ?loc:ast.loc Pp.(str "fatal, got no `NewTip`"); stt := doc, n_st with exn -> begin CLexer.Lexer.State.set l_post_st; raise exn end done; !stt with End_of_input -> !stt let close_document ~doc ~pstate = let _doc = Stm.join ~doc in Serapi.Serapi_doc.check_pending_proofs ~pstate let sertok_version = Sertop.Ser_version.ser_git_version let sertok_man = [ `S "DESCRIPTION"; `P "Experimental Coq tokenizer."; `S "USAGE"; `P "To serialize tokens in the file `fs/fun.v` with logical path `Funs`:"; `Pre "sertok -Q fs,Funs fs/fun.v > fs/fun.sexp"; `P "See the documentation on the project's website for more information." ] let sertok_doc = "sertok Coq tokenizer" open Cmdliner let driver debug set_impredicative_set disallow_sprop printer async async_workers error_recovery quick coq_path ml_path load_path rload_path in_file omit_loc omit_att omit_env exn_on_opaque indices_matter = (* closures *) let pp = Sertop.Sertop_ser.select_printer printer in (* initialization *) let doc, sid = Sertop.Comp_common.create_document ~debug ~set_impredicative_set ~disallow_sprop ~ml_path ~load_path ~rload_path ~quick ~in_file ~indices_matter ~omit_loc ~omit_att ~exn_on_opaque ~omit_env ~coq_path ~async ~async_workers ~error_recovery in (* main loop *) let in_chan = open_in in_file in let doc, _sid = input_doc ~pp ~in_file ~in_chan ~doc ~sid in let pstate = match Stm.state_of_id ~doc sid with | Valid (Some { Vernacstate.interp = { lemmas; _ }; _ }) -> lemmas | _ -> None in let () = close_document ~doc ~pstate in () let main () = let input_file = let doc = "Input file." in Arg.(required & pos 0 (some string) None & info [] ~docv:("FILE") ~doc) in let sertok_cmd = let open Sertop.Sertop_arg in let term = Term.(const driver $ debug $ set_impredicative_set $ disallow_sprop $ printer $ async $ async_workers $ error_recovery $ quick $ prelude $ ml_include_path $ load_path $ rload_path $ input_file $ omit_loc $ omit_att $ omit_env $ exn_on_opaque $ indices_matter ) in let info = Cmd.info "sertok" ~version:sertok_version ~doc:sertok_doc ~man:sertok_man in Cmd.v info term in try let ecode = Cmd.eval ~catch:false sertok_cmd in exit ecode with exn -> let (e, info) = Exninfo.capture exn in Sertop.Comp_common.fatal_exn e info let _ = main () coq-serapi-8.20.0-0.20.0/sertop/sertop.el000066400000000000000000000071411466734233400175500ustar00rootroot00000000000000;;; sertop.el --- Sertop REPL in Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 2016 Clément Pit-Claudel ;; Author: Clément Pit--Claudel ;; Keywords: convenience ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Open `sertop.el` and run `M-x eval-buffer` followed by `M-x ;;; sertop` to get a sertop REPL in Emacs, with highlighting and ;;; pretty-printing (useful for debugging). ;;; You may want to configure the variable `sertop-coq-directory` to ;;; point out the location of Coq's stdlib. ;;; Code: (require 'comint) (defconst sertop--root (file-name-directory (or load-file-name (bound-and-true-p byte-compile-current-file) (buffer-file-name)))) (defvar sertop-executable-path (or (expand-file-name "sertop.native" sertop--root) (executable-find "sertop")) "Path to sertop.") (defvar sertop-coq-directory nil "Location of the directory containing Coq's sources, or nil.") (defvar-local sertop--accumulator nil "List of strings accumulated from sertop in reverse order.") (defun sertop--format (response) "Read RESPONSE into a sexp and return a pretty-printed, indented copy." (replace-regexp-in-string "^\\(.\\)" " \\1" (pp-to-string (read response)) t)) (defun sertop--preoutput-filter (string) "Accumulate STRING, returning full responses." (let* ((parts (split-string string "\0" nil)) (messages nil)) (while (consp (cdr parts)) (push (pop parts) sertop--accumulator) (push (apply #'concat (nreverse sertop--accumulator)) messages) (setq sertop--accumulator nil)) (push (car parts) sertop--accumulator) (mapconcat #'sertop--format (nreverse messages) ""))) (defconst sertop--font-lock-keywords '(("([A-Z]\\(\\w\\|\\s_\\|\\\\.\\)+\\(\\s-\\|\n\\)" . font-lock-function-name-face) ("(\\(\\w\\|\\s_\\|\\\\.\\)+\\(\\s-\\|\n\\)" . font-lock-variable-name-face) ("\\_" . font-lock-builtin-face)) "Font lock pairs for `sertop-mode'.") (defvar sertop-mode-syntax-table lisp-mode-syntax-table "Syntax table for `sertop-mode'.") (define-derived-mode sertop-mode comint-mode "Sertop" "Major mode for interacting with Sertop. Output is accumulated and printed once a full message has been received." (setq comint-process-echoes nil) (setq comint-use-prompt-regexp nil) (setq font-lock-defaults '(sertop--font-lock-keywords)) (when (fboundp 'rainbow-delimiters-mode) (rainbow-delimiters-mode)) (add-hook 'comint-preoutput-filter-functions #'sertop--preoutput-filter nil t)) (defun sertop--args () "Compute sertop arguments." `("--print0" ,@(when sertop-coq-directory `("--prelude" ,sertop-coq-directory)))) (defun sertop () "Launch sertop." (interactive) (let ((buffer (get-buffer-create (generate-new-buffer-name "*Sertop*")))) (pop-to-buffer buffer) (apply 'make-comint-in-buffer "Sertop" buffer sertop-executable-path nil (sertop--args)) (sertop-mode))) (provide 'sertop) ;;; sertop.el ends here coq-serapi-8.20.0-0.20.0/sertop/sertop_arg.ml000066400000000000000000000172451466734233400204170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* coqlib | None -> Coq_config.coqlib [@@@ocaml.warning "-44-45"] let prelude = let doc = "Load Coq.Init.Prelude from $(docv); plugins/ and theories/ should live there." in Arg.(value & opt string coqlib_from_env_or_config & info ["coqlib"] ~docv:"COQPATH" ~doc) let require_lib = let doc = "Coq module to require." in Arg.(value & opt (some string) None & info ["require-lib"] ~doc) let str_pp = let doc = "Pretty-print constr strings." in Arg.(value & flag & info ["str-pp"] ~doc) let de_bruijn = let doc = "Print constrs with de Bruijn indices." in Arg.(value & flag & info ["de-bruijn"] ~doc) let body = let doc = "Print bodies of constrs." in Arg.(value & flag & info ["body"] ~doc) let async = let doc = "Enable async support using Coq binary $(docv) (experimental)." in Arg.(value & opt (some string) None & info ["async"] ~doc ~docv:"COQTOP") let quick = let doc = "Skip checking opaque proofs (very experimental)." in Arg.(value & flag & info ["quick"] ~doc) let async_full = let doc = "Enable Coq's async_full option." in Arg.(value & flag & info ["async-full"] ~doc) let deep_edits = let doc = "Enable Coq's deep document edits option." in Arg.(value & flag & info ["deep-edits"] ~doc) let async_workers = let doc = "Maximum number of async workers." in Arg.(value & opt int 3 & info ["async-workers"] ~doc) let error_recovery = let doc = "Enable Coq's error recovery inside tactics and commands." in Arg.(value & flag & info ["error-recovery"] ~doc) let implicit_stdlib = let doc = "No-op (used to allow loading unqualified stdlib libraries, which is now the default)." in Arg.(value & flag & info ["implicit"] ~doc) let print_args = let open Sertop_ser in Arg.(enum ["sertop", SP_Sertop; "human", SP_Human; "mach", SP_Mach]) let print_args_doc = Arg.doc_alts ["sertop, a custom printer (UTF-8 with emacs-compatible quoting)"; "human, sexplib's human-format printer (recommended for debug sessions)"; "mach, sexplib's machine-format printer" ] let printer = let open Sertop_ser in (* XXX Must improve argument information *) (* let doc = "Select S-expression printer." in *) Arg.(value & opt print_args SP_Sertop & info ["printer"] ~doc:print_args_doc) let debug = let doc = "Enable debug mode for Coq." in Arg.(value & flag & info ["debug"] ~doc) let set_impredicative_set = let doc = "Enable Coq -impredicative-set option (disabled by default)" in Arg.(value & flag & info ["impredicative-set"] ~doc) let disallow_sprop = let doc = "Forbid using the proof irrelevant SProp sort (allowed by default)" in Arg.(value & flag & info ["disallow-sprop"] ~doc) let indices_matter = let doc = "Levels of indices (and nonuniform parameters) contribute to the level of inductives (disabled by default)" in Arg.(value & flag & info ["indices-matter"] ~doc) let print0 = let doc = "End responses with a \\\\0 char." in Arg.(value & flag & info ["print0"] ~doc) let length = let doc = "Emit a byte-length header before output. (deprecated)." in Arg.(value & flag & info ["length"] ~doc) (* We handle the conversion here *) let no_init = let doc = "Omits the creation of a new document; this means the user \ will have to call `(NewDoc ...)` before Coq can be used \ and set there the proper loadpath, requires, ..." in Arg.(value & flag & info ["no_init"] ~doc) let topfile = let doc = "Set the toplevel name as though compiling $(docv)" in Arg.(value & opt (some string) None & info ["topfile"] ~doc ~docv:"TOPFILE") let no_prelude = let doc = "Omits requiring any module on start, thus `Prelude`, ltac, etc... won't be available" in Arg.(value & flag & info ["no_prelude"] ~doc) let coq_lp_conv ~implicit (unix_path,lp) = Loadpath.{ coq_path = Libnames.dirpath_of_string lp ; unix_path ; has_ml = true ; recursive = true ; implicit } let rload_path : Loadpath.vo_path list Term.t = let doc = "Bind a logical loadpath LP to a directory DIR and implicitly open its namespace." in Term.(const List.(map (coq_lp_conv ~implicit:true)) $ Arg.(value & opt_all (pair dir string) [] & info ["R"; "rec-load-path"] ~docv:"DIR,LP"~doc)) let load_path : Loadpath.vo_path list Term.t = let doc = "Bind a logical loadpath LP to a directory DIR" in Term.(const List.(map (coq_lp_conv ~implicit:false)) $ Arg.(value & opt_all (pair dir string) [] & info ["Q"; "load-path"] ~docv:"DIR,LP" ~doc)) let ml_include_path : string list Term.t = let doc = "Include DIR in default loadpath, for locating ML files" in Arg.(value & opt_all dir [] & info ["I"; "ml-include-path"] ~docv:"DIR" ~doc) (* Low-level serialization options for display *) let omit_loc : bool Term.t = let doc = "[debug option] shorten location printing" in Arg.(value & flag & info ["omit_loc"] ~doc) let omit_att : bool Term.t = let doc = "[debug option] omit attribute nodes" in Arg.(value & flag & info ["omit_att"] ~doc) let omit_env : bool Term.t = let doc = "[debug option] turn enviroments into abstract objects" in Arg.(value & flag & info ["omit_env"] ~doc) let exn_on_opaque : bool Term.t = let doc = "[debug option] raise an exception on non-serializeble terms" in Arg.(value & flag & info ["exn_on_opaque"] ~doc) (* sertop options *) type comp_mode = | C_parse | C_stats | C_print | C_sexp | C_check | C_vo | C_env let comp_mode_args = Arg.(enum [ "parse", C_parse ; "stats", C_stats ; "print", C_print ; "sexp", C_sexp ; "check", C_check ; "vo", C_vo ; "kenv", C_env ]) let comp_mode_doc = Arg.doc_alts [ "parse: parse the file and remain silent (except for Coq output)" ; "stats: output stats on the input file" ; "print: output using the Coq pretty printer" ; "sexp: output serialized version of the input file" ; "check: check proofs in the file and remain silent (except for Coq output)" ; "vo: check proofs and output .vo version of the input file" ; "kenv: check proofs and output the final kernel enviroment" ] let comp_mode = Arg.(value & opt comp_mode_args C_parse & info ["mode"] ~doc:comp_mode_doc) type comp_input = | I_vernac | I_sexp let comp_input_args = Arg.(enum [ "vernac", I_vernac ; "sexp", I_sexp]) let comp_input_doc = Arg.doc_alts [ "vernac: Coq vernacular" ; "sexp: serialized Coq vernacular" ] let comp_input = Arg.(value & opt comp_input_args I_vernac & info ["input"] ~doc:comp_input_doc) coq-serapi-8.20.0-0.20.0/sertop/sertop_arg.mli000066400000000000000000000047461466734233400205720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Feedback.feedback -> unit (* callback to handle async feedback *) ; plugin_load : (string list -> unit) option (* callback to load findlib packages *) ; debug : bool (* Enable Coq Debug mode *) ; set_impredicative_set : bool (* Enable -impredicative-set option *) ; allow_sprop : bool (* Allow SProp *) ; indices_matter : bool ; ml_path : string list ; vo_path : Loadpath.vo_path list (** From -R and -Q options usually *) } (**************************************************************************) (* Low-level, internal Coq initialization *) (**************************************************************************) (* Reference to feedback_handler *) let fb = ref 0 (* mirroring what's done in Coqinit.init_runtime () *) let init_runtime opts = (* Core Coq initialization *) Lib.init(); (* --impredicative-set option *) Global.set_impredicative_set opts.set_impredicative_set; Global.set_indices_matter opts.indices_matter; (* --allow-sprop in agreement with coq v8.11 *) Global.set_allow_sprop opts.allow_sprop; (* XXX fixme *) Global.set_native_compiler false; (* Loadpath is early in the state now *) (* This is for defaults, in case we go back to the protocol setting it *) (* let dft_ml, dft_vo = * Serapi.Serapi_paths.(coq_loadpath_default ~implicit:true ~coq_path:Coq_config.coqlib) * in * let ml_load_path = Option.default dft_ml opts.ml_path in * let vo_load_path = Option.default dft_vo opts.vo_path in *) List.iter Mltop.add_ml_dir opts.ml_path; List.iter Loadpath.add_vo_path opts.vo_path; () let coq_init opts out_fmt = if opts.debug then begin Printexc.record_backtrace true; (* XXX Use CDebug *) (* Flags.debug := true; *) end; let load_plugin = Coq.Loader.plugin_handler opts.plugin_load in (* Custom toplevel is used for bytecode-to-js dynlink *) let ser_mltop : Mltop.toplevel = let open Mltop in { load_plugin ; load_module = Dynlink.loadfile (* We ignore all the other operations for now. *) ; add_dir = (fun _ -> ()) ; ml_loop = (fun ?init_file:_ _ -> ()) } in Mltop.set_top ser_mltop; init_runtime opts; (**************************************************************************) (* Feedback setup *) (**************************************************************************) (* Initialize logging. *) fb := Feedback.add_feeder (opts.fb_handler out_fmt); (**************************************************************************) (* Start the STM!! *) (**************************************************************************) Stm.init_core (); (* End of initialization *) () let update_fb_handler ~pp_feed out_fmt = Feedback.del_feeder !fb; fb := Feedback.add_feeder (pp_feed out_fmt) (******************************************************************************) (* Async setup *) (******************************************************************************) (* Set async flags; IMPORTANT, this has to happen before STM.init () ! *) let process_stm_flags opts = let stm_opts = Stm.AsyncOpts.default_opts in (* Process error resilience *) let async_proofs_tac_error_resilience, async_proofs_cmd_error_resilience = if opts.error_recovery then Stm.AsyncOpts.FAll, true else Stm.AsyncOpts.FNone, false in let stm_opts = { stm_opts with async_proofs_tac_error_resilience ; async_proofs_cmd_error_resilience } in (* Enable async mode if requested *) Option.cata (fun coqtop -> let open Stm.AsyncOpts in let opts = { stm_opts with async_proofs_mode = APon (* Imitate CoqIDE *) ; async_proofs_never_reopen_branch = not opts.deep_edits ; async_proofs_n_workers = opts.async_workers ; async_proofs_n_tacworkers = opts.async_workers } in (* async_proofs_worker_priority); *) (* Whether to forward Glob output to the IDE. *) (* let _dump_opt = "-no-glob" in * AsyncTaskQueue.async_proofs_flags_for_workers := []; *) (* The -no-glob for workers seems broken recently *) AsyncTaskQueue.async_proofs_flags_for_workers := []; (* This is not needed as we won't run workers from the cmdline "build system" *) (* CoqworkmgrApi.(init High); *) (* Uh! XXXX *) for i = 0 to Array.length Sys.argv - 1 do Array.set Sys.argv i "-m" done; Array.set Sys.argv 0 coqtop; opts ) stm_opts opts.enable_async coq-serapi-8.20.0-0.20.0/sertop/sertop_init.mli000066400000000000000000000046471466734233400207640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Stm.AsyncOpts.stm_opt (** [process_stm_flags flags] transforms SerAPI flags into Coq flags *) type coq_opts = { fb_handler : Format.formatter -> Feedback.feedback -> unit (** callback to handle async feedback *) ; plugin_load : (string list -> unit) option (** callback to load findlib plugins *) ; debug : bool (** Enable Coq Debug mode *) ; set_impredicative_set : bool (** Enable [-impredicative-set] option in Coq (default=false) *) ; allow_sprop : bool (** allow using the proof irrelevant SProp sort (default=true) *) ; indices_matter : bool (** Levels of indices (and nonuniform parameters) contribute to the level of inductives *) ; ml_path : string list ; vo_path : Loadpath.vo_path list (** From -R and -Q options usually *) } val coq_init : coq_opts -> Format.formatter -> unit (** [coq_init opts] Initialize Coq. This doesn't create a Proof Document. *) val update_fb_handler : pp_feed:(Format.formatter -> Feedback.feedback -> unit) -> Format.formatter -> unit coq-serapi-8.20.0-0.20.0/sertop/sertop_ser.ml000066400000000000000000000214131466734233400204270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Js_sexp_printer.pp_sertop | SP_Mach -> Sexp.pp | SP_Human -> Sexp.pp_hum module SP = Serapi.Serapi_protocol (******************************************************************************) (* Exception Registration *) (******************************************************************************) (* We play slow for now *) let _ = (* XXX Finish this *) let open Sexp in let sexp_of_std_ppcmds pp = Atom (Pp.string_of_ppcmds pp) in Conv.Exn_converter.add [%extension_constructor SP.NoSuchState] (function (* Own things *) | SP.NoSuchState sid -> List [Atom "NoSuchState"; Ser_stateid.sexp_of_t sid] | _ -> assert false); Conv.Exn_converter.add [%extension_constructor CErrors.UserError] (function (* Errors *) | CErrors.UserError(msg) -> List [Atom "CErrors.UserError"; List [sexp_of_std_ppcmds msg]] | _ -> assert false); Conv.Exn_converter.add [%extension_constructor DeclareUniv.AlreadyDeclared] (function | DeclareUniv.AlreadyDeclared (msg, id) -> List [Atom "Declare.AlreadyDeclared"; List [sexp_of_option sexp_of_string msg; Ser_names.Id.sexp_of_t id]] | _ -> assert false); Conv.Exn_converter.add [%extension_constructor Pretype_errors.PretypeError] (function (* Pretype Errors XXX what to do with _env, _envmap *) | Pretype_errors.PretypeError(_env, _evmap, pterr) -> List [Atom "Pretype_errors.PretypeError"; List [Ser_pretype_errors.sexp_of_pretype_error pterr]] | _ -> assert false); (* Conv.Exn_converter.add [%extension_constructor Proof_global.NoCurrentProof] (function * | Proof_global.NoCurrentProof -> * Atom "NoCurrentProof" * | _ -> assert false) *) (* Private... request Coq devs to make them public? | Errors.Anomaly(msgo, pp) -> Some (List [Atom "Anomaly"; sexp_of_option sexp_of_string msgo; sexp_of_std_ppcmds pp]) *) (******************************************************************************) (* Serialization of the Protocol *) (******************************************************************************) module Loc = Ser_loc module CAst = Ser_cAst module Pp = Ser_pp module Names = Ser_names module Environ = Ser_environ module Goptions = Ser_goptions module Stateid = Ser_stateid module Evar = Ser_evar module Context = Ser_context module Feedback = Ser_feedback module Libnames = Ser_libnames module Lib = Ser_lib module Nametab = Ser_nametab module Globnames = Ser_globnames module Impargs = Ser_impargs module Constr = Ser_constr module EConstr = Ser_eConstr module Constrexpr = Ser_constrexpr module Tok = Ser_tok module Ppextend = Ser_ppextend module Notation_gram = Ser_notation_gram module Genarg = Ser_genarg module Loadpath = Ser_loadpath module Printer = Ser_printer module Profile_tactic = Ser_profile_tactic (* Alias fails due to the [@@default in protocol] *) module Ser_stm = Serlib_extra.Ser_stm module Coqargs = Serlib_extra.Ser_coqargs module Ltac_plugin = struct module Tacenv = Serlib_ltac.Ser_tacenv module Tacexpr = Serlib_ltac.Ser_tacexpr end module Notation = Ser_notation module Xml_datatype = Ser_xml_datatype module Notation_term = Ser_notation_term module Vernacexpr = Ser_vernacexpr module Declarations = Ser_declarations (* module Richpp = Ser_richpp *) module Summary = Ser_summary module Serapi = struct module Serapi_goals = struct type 'a hyp = [%import: 'a Serapi.Serapi_goals.hyp] [@@deriving sexp] type info = [%import: Serapi.Serapi_goals.info] [@@deriving sexp] type 'a reified_goal = [%import: 'a Serapi.Serapi_goals.reified_goal] [@@deriving sexp] type 'a ser_goals = [%import: 'a Serapi.Serapi_goals.ser_goals] [@@deriving sexp] end module Serapi_assumptions = struct type ax_ctx = [%import: Serapi.Serapi_assumptions.ax_ctx] [@@deriving sexp] type t = [%import: Serapi.Serapi_assumptions.t] [@@deriving sexp] end module Serapi_protocol = Serapi.Serapi_protocol end (* Serialization to sexp *) type coq_object = [%import: Serapi.Serapi_protocol.coq_object] [@@deriving sexp] exception AnswerExn of Sexp.t let exn_of_sexp sexp = AnswerExn sexp type print_format = [%import: Serapi.Serapi_protocol.print_format] [@@deriving sexp] type format_opt = [%import: Serapi.Serapi_protocol.format_opt] [@@deriving sexp] type print_opt = [%import: Serapi.Serapi_protocol.print_opt] [@@deriving sexp] type query_pred = [%import: Serapi.Serapi_protocol.query_pred] [@@deriving sexp] type query_opt = [%import: Serapi.Serapi_protocol.query_opt [@with Sexplib.Conv.sexp_list := sexp_list; Sexplib.Conv.sexp_option := sexp_option; ]] [@@deriving sexp] type query_cmd = [%import: Serapi.Serapi_protocol.query_cmd] [@@deriving sexp] type cmd_tag = [%import: Serapi.Serapi_protocol.cmd_tag] [@@deriving sexp] type location = [%import: Printexc.location] [@@deriving sexp] type raw_backtrace = Printexc.raw_backtrace let raw_backtrace_of_sexp _ = Printexc.get_raw_backtrace () type slot_rep = { slot_loc : location option; slot_idx : int; slot_str : string option; } [@@deriving sexp] let to_slot_rep idx bs = { slot_loc = Printexc.Slot.location bs; slot_idx = idx; slot_str = Printexc.Slot.format idx bs; } let sexp_of_backtrace_slot idx bs = sexp_of_slot_rep (to_slot_rep idx bs) let sexp_of_raw_backtrace (bt : Printexc.raw_backtrace) : Sexp.t = let bt = Printexc.backtrace_slots bt in let bt = Option.map Array.(mapi sexp_of_backtrace_slot) bt in let bt = sexp_of_option (sexp_of_array (fun x -> x)) bt in Sexp.(List [Atom "Backtrace"; bt]) module ExnInfo = struct type t = [%import: Serapi.Serapi_protocol.ExnInfo.t [@with Stm.focus := Ser_stm.focus; Printexc.raw_backtrace := raw_backtrace; Stdlib.Printexc.raw_backtrace := raw_backtrace; ]] [@@deriving sexp] end type answer_kind = [%import: Serapi.Serapi_protocol.answer_kind [@with Exninfo.t := Exninfo.t; Stm.add_focus := Ser_stm.add_focus; ]] [@@deriving sexp] type feedback_content = [%import: Serapi.Serapi_protocol.feedback_content] [@@deriving sexp] type feedback = [%import: Serapi.Serapi_protocol.feedback] [@@deriving sexp] type answer = [%import: Serapi.Serapi_protocol.answer] [@@deriving sexp] type add_opts = [%import: Serapi.Serapi_protocol.add_opts [@with Sexplib.Conv.sexp_option := sexp_option; ]] [@@deriving sexp] type newdoc_opts = [%import: Serapi.Serapi_protocol.newdoc_opts [@with (* Stm.interactive_top := Ser_stm.interactive_top; *) Sexplib.Conv.sexp_list := sexp_list; Sexplib.Conv.sexp_option := sexp_option; ]] [@@deriving sexp] type save_opts = [%import: Serapi.Serapi_protocol.save_opts] [@@deriving sexp] type parse_entry = [%import: Serapi.Serapi_protocol.parse_entry] [@@deriving sexp] type parse_opt = [%import: Serapi.Serapi_protocol.parse_opt [@with Sexplib.Conv.sexp_option := sexp_option; ]] [@@deriving sexp] type cmd = [%import: Serapi.Serapi_protocol.cmd] [@@deriving sexp] type tagged_cmd = [%import: Serapi.Serapi_protocol.tagged_cmd] [@@deriving sexp] type sentence = Sentence of Tok.t CAst.t list [@@deriving sexp] coq-serapi-8.20.0-0.20.0/sertop/sertop_ser.mli000066400000000000000000000052341466734233400206030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Format.formatter -> Sexp.t -> unit open Serapi.Serapi_protocol val coq_object_of_sexp : Sexp.t -> coq_object val sexp_of_coq_object : coq_object -> Sexp.t val print_format_of_sexp : Sexp.t -> print_format val sexp_of_print_format : print_format -> Sexp.t val print_opt_of_sexp : Sexp.t -> print_opt val sexp_of_print_opt : print_opt -> Sexp.t val sexp_of_answer_kind : answer_kind -> Sexp.t val answer_kind_of_sexp : Sexp.t -> answer_kind val query_pred_of_sexp : Sexp.t -> query_pred val sexp_of_query_pred : query_pred -> Sexp.t val query_opt_of_sexp : Sexp.t -> query_opt val sexp_of_query_opt : query_opt -> Sexp.t val query_cmd_of_sexp : Sexp.t -> query_cmd val sexp_of_query_cmd : query_cmd -> Sexp.t val cmd_of_sexp : Sexp.t -> cmd val sexp_of_cmd : cmd -> Sexp.t type nonrec tagged_cmd = tagged_cmd val tagged_cmd_of_sexp : Sexp.t -> tagged_cmd val sexp_of_tagged_cmd : tagged_cmd -> Sexp.t val sexp_of_answer : answer -> Sexp.t val answer_of_sexp : Sexp.t -> answer type sentence = Sentence of Tok.t CAst.t list val sexp_of_sentence : sentence -> Sexp.t val sentence_of_sexp : Sexp.t -> sentence (* end *) coq-serapi-8.20.0-0.20.0/sertop/sertop_sexp.ml000066400000000000000000000231101466734233400206110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* true | _ -> false (* Loop state *) module Ctx = struct type t = { in_chan : Stdlib.in_channel ; out_chan : Stdlib.out_channel ; out_fmt : Format.formatter ; cmd_id : int ; st : SP.State.t } let make ?in_file ?ldir ~cmd_id ~in_chan ~out_chan () = let out_fmt = Format.formatter_of_out_channel out_chan in let st = SP.State.make ?in_file ?ldir () in { out_chan; out_fmt; in_chan; cmd_id; st } end (* XXX: Improve by using manual tag parsing. *) let read_cmd ~(ctx : Ctx.t) ~pp_err = let rec read_loop () = try let cmd_sexp = Sexp.input_sexp ctx.in_chan in begin try sertop_cmd_of_sexp cmd_sexp with | _exn -> begin try SerApi (Sertop_ser.tagged_cmd_of_sexp cmd_sexp) with | _exn -> SerApi (string_of_int ctx.cmd_id, Sertop_ser.cmd_of_sexp cmd_sexp) end end with | End_of_file -> Quit | exn -> pp_err ctx.out_fmt (sexp_of_exn exn); (read_loop [@ocaml.tailcall]) () in read_loop () let out_sexp opts = let open Format in let pp_sexp = Sertop_ser.select_printer opts.printer in let pp_term = if opts.print0 then fun fmt () -> fprintf fmt "%c" (Char.chr 0) else fun fmt () -> fprintf fmt "@\n" in if opts.lheader then fun fmt a -> fprintf str_formatter "@[%a@]%a%!" pp_sexp a pp_term (); let out = flush_str_formatter () in fprintf fmt "@[byte-length: %d@\n%s@]%!" (String.length out) out else fun fmt a -> fprintf fmt "@[%a@]%a%!" pp_sexp a pp_term () (** We could use Sexp.to_string too *) let out_answer opts = let pp_sexp = out_sexp opts in fun fmt a -> pp_sexp fmt (Sertop_ser.sexp_of_answer a) (** Set the topname from optional topfile string or default if None **) let doc_type topfile = match topfile with | None -> let sertop_dp = Names.(DirPath.make [Id.of_string "SerTop"]) in Stm.Interactive (TopLogical sertop_dp) | Some filename -> Stm.Interactive (Coqargs.TopPhysical filename) let process_serloop_cmd ~(ctx : Ctx.t) ~pp_ack ~pp_answer ~pp_err ~pp_feed (cmd : sertop_cmd) : Ctx.t = let out = ctx.out_fmt in (* Collect terminated children *) let () = try let _pid, _status = Unix.waitpid [Unix.WNOHANG] (-1) in () with Unix.Unix_error(Unix.ECHILD, _, _) -> (* No children for now *) () in match cmd with | SerApi (cmd_tag, cmd) -> pp_ack out cmd_tag; let ans, st = SP.exec_cmd ctx.st cmd in List.iter (pp_answer out) @@ List.map (fun a -> SP.Answer (cmd_tag, a)) ans; { ctx with st } | Fork { fifo_in ; fifo_out } -> let pid = Unix.fork () in if pid = 0 then begin (* Children: close previous channels *) Stdlib.close_in ctx.in_chan; Format.pp_print_flush ctx.out_fmt (); Stdlib.close_out ctx.out_chan; (* Create new ones *) let () = Unix.mkfifo fifo_in 0o640 in let in_chan = Stdlib.open_in fifo_in in let () = Unix.mkfifo fifo_out 0o640 in let out_chan = Stdlib.open_out fifo_out in let out_fmt = Format.formatter_of_out_channel out_chan in Sertop_init.update_fb_handler ~pp_feed out_fmt; { ctx with in_chan; out_chan; out_fmt } end else (* Parent *) let () = pp_err out Sexp.(List [Atom "Forked"; Atom (string_of_int pid)]) in ctx | Quit -> ctx let ser_loop ser_opts = (* Create closures for printers given initial options *) let pp_answer = out_answer ser_opts in let pp_err = out_sexp ser_opts in (* XXX EG: I don't understand this well, why is this lock needed ?? Review fork code in CoqworkmgrApi *) let pr_mutex = Mutex.create () in let ser_lock f x = Mutex.lock pr_mutex; f x; Mutex.unlock pr_mutex in (* Wrap printers *) let pp_answer out = ser_lock (pp_answer out) in let pp_err out = ser_lock (pp_err out) in let pp_ack out cid = pp_answer out (SP.Answer (cid, SP.Ack)) in let pp_opt fb = Sertop_util.feedback_opt_filter fb in let pp_feed out fb = Option.iter (fun fb -> pp_answer out (SP.Feedback (Sertop_util.feedback_tr fb))) (pp_opt fb) in let ldir = Option.map Serapi.Serapi_paths.dirpath_of_file ser_opts.topfile in let ctx = Ctx.make ?in_file:ser_opts.topfile ?ldir ~cmd_id:0 ~in_chan:ser_opts.in_chan ~out_chan:ser_opts.out_chan () in (* Init Coq *) let ml_path, vo_path = ser_opts.ml_path, ser_opts.vo_path in let () = Sertop_init.( coq_init { fb_handler = pp_feed ; plugin_load = None ; debug = ser_opts.debug ; set_impredicative_set = ser_opts.set_impredicative_set ; allow_sprop = ser_opts.allow_sprop ; indices_matter = ser_opts.indices_matter ; ml_path ; vo_path }) ctx.out_fmt in (* Follow the same approach than coqtop for now: allow Coq to be * interrupted by Ctrl-C. Not entirely safe or race free... but we * trust the IDEs to send the signal on coherent IO state. *) Sys.catch_break true; let injections = if ser_opts.no_prelude then [] else [Coqargs.RequireInjection {lib="Coq.Init.Prelude"; prefix=None; export=Some Lib.Import;}] in let stm_options = Sertop_init.process_stm_flags ser_opts.async in Stm.init_process stm_options; if not ser_opts.no_init then begin let ndoc = { Stm.doc_type = doc_type ser_opts.topfile ; injections } in let _ = Stm.new_doc ndoc in () end; let incr_cmdid (ctx : Ctx.t) = { ctx with cmd_id = ctx.cmd_id + 1 } in (* Main loop *) let rec loop ctx = let quit, ctx = try let scmd = read_cmd ~ctx ~pp_err in ( is_cmd_quit scmd , process_serloop_cmd ~ctx ~pp_ack ~pp_answer ~pp_err ~pp_feed scmd) with Sys.Break -> false, ctx in if quit then () else (loop [@ocaml.tailcall]) (incr_cmdid ctx) in loop ctx coq-serapi-8.20.0-0.20.0/sertop/sertop_sexp.mli000066400000000000000000000054331466734233400207720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit (** [ser_loop opts] main se(xp)r-protocol interactive loop *) coq-serapi-8.20.0-0.20.0/sertop/sertop_util.ml000066400000000000000000000075721466734233400206250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* [] | (Ppcmd_glue g :: l) -> flatten_glue (List.map repr g @ flatten_glue l) | (Ppcmd_string s1 :: Ppcmd_string s2 :: l) -> flatten_glue (Ppcmd_string (s1 ^ s2) :: flatten_glue l) | (x :: l) -> x :: flatten_glue l in (* let rec flatten_glue l = match l with *) (* | (Ppcmd_string s1 :: Ppcmd_string s2 :: l) -> Ppcmd_string (s1 ^ s2) :: flatten_glue l *) unrepr (match repr d with | Ppcmd_glue [] -> Ppcmd_empty | Ppcmd_glue [x] -> repr (coq_pp_opt x) | Ppcmd_glue l -> Ppcmd_glue List.(map coq_pp_opt (map unrepr (flatten_glue (map repr l)))) | Ppcmd_box(bt,d) -> Ppcmd_box(bt, coq_pp_opt d) | Ppcmd_tag(t, d) -> Ppcmd_tag(t, coq_pp_opt d) | d -> d ) (* Adjust positions from byte to UTF-8 chars *) (* XXX: Move to serapi/ *) (* We only do adjustement for messages for now. *) module F = Feedback let feedback_content_pos_filter txt (fbc : F.feedback_content) : F.feedback_content = let adjust _txt loc = loc in match (fbc : F.feedback_content) with | F.Message (lvl,loc,msg) -> F.Message (lvl, adjust txt loc, msg) | _ -> fbc let feedback_pos_filter text (fb : F.feedback) : F.feedback = { fb with F.contents = feedback_content_pos_filter text fb.F.contents; } (* Optimizes and filters feedback *) type fb_filter_opts = { pp_opt : bool; } let default_fb_filter_opts = { pp_opt = true; } let feedback_content_tr (fb : F.feedback_content) : Serapi.Serapi_protocol.feedback_content = match fb with | F.Message (level, loc, pp) -> let str = Pp.string_of_ppcmds pp in Message { level; loc; pp; str } | F.Processed -> Processed | F.Incomplete -> Incomplete | F.Complete -> Complete | F.ProcessingIn s -> ProcessingIn s | F.InProgress i -> InProgress i | F.WorkerStatus (s1,s2) -> WorkerStatus (s1,s2) | F.AddedAxiom -> AddedAxiom | F.GlobRef (_, _, _, _, _) -> assert false | F.GlobDef (_, _, _, _) -> assert false | F.FileDependency (o, p) -> FileDependency (o,p) | F.FileLoaded (o, p) -> FileLoaded (o, p) | F.Custom (_, _, _) -> assert false let feedback_tr (fb : Feedback.feedback) : Serapi.Serapi_protocol.feedback = match fb with | { doc_id; span_id; route; contents } -> let contents = feedback_content_tr contents in { doc_id; span_id; route; contents } let feedback_opt_filter ?(opts=default_fb_filter_opts) = let open Feedback in function | { F.contents = Message (lvl, loc, msg); _ } as fb -> Some (if opts.pp_opt then { fb with contents = Message(lvl, loc, coq_pp_opt msg) } else fb) | { F.contents = FileDependency _ ; _ } -> None | fb -> Some fb coq-serapi-8.20.0-0.20.0/sertop/sertop_util.mli000066400000000000000000000031011466734233400207560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp.t val feedback_pos_filter : string -> Feedback.feedback -> Feedback.feedback (* Optimizer/filter for feedback *) type fb_filter_opts = { pp_opt : bool; } val default_fb_filter_opts : fb_filter_opts val feedback_opt_filter : ?opts:fb_filter_opts -> Feedback.feedback -> Feedback.feedback option val feedback_tr : Feedback.feedback -> Serapi.Serapi_protocol.feedback coq-serapi-8.20.0-0.20.0/tests/000077500000000000000000000000001466734233400155355ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/tests/async/000077500000000000000000000000001466734233400166525ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/tests/async/dune000066400000000000000000000002471466734233400175330ustar00rootroot00000000000000; Broken ; (alias ; (name runtest) ; (deps (:input quote.v)) ; (action (ignore-outputs ; (bash "%{bin:sercomp} --async=coqtop --mode=check %{input}")))) coq-serapi-8.20.0-0.20.0/tests/async/quote.v000066400000000000000000000004031466734233400201730ustar00rootroot00000000000000Require Import Arith. Require Import List. Import ListNotations. Set Implicit Arguments. Lemma leb_false_lt : forall m n, leb m n = false -> n < m. Proof. induction m; intros. - discriminate. - simpl in *. destruct n; subst; auto with arith. Qed. coq-serapi-8.20.0-0.20.0/tests/fail/000077500000000000000000000000001466734233400164505ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/tests/fail/assoc.v000066400000000000000000000043221466734233400177500ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Ltac break_match_hyp := match goal with | [ H : context [ match ?X with _ => _ end ] |- _] => match type of X with | sumbool _ _ => destruct X | _ => destruct X eqn:? end end. Ltac break_match_goal := match goal with | [ |- context [ match ?X with _ => _ end ] ] => match type of X with | sumbool _ _ => destruct X | _ => destruct X eqn:? end end. Ltac break_match := break_match_goal || break_match_hyp. Section assoc. Variable K V : Type. Variable K_eq_dec : forall k k' : K, {k = k'} + {k <> k'}. Fixpoint assoc (l : list (K * V)) (k : K) : option V := match l with | [] => None | (k', v) :: l' => if K_eq_dec k k' then Some v else assoc l' k end. Definition assoc_default (l : list (K * V)) (k : K) (default : V) : V := match (assoc l k) with | Some x => x | None => default end. Fixpoint assoc_set (l : list (K * V)) (k : K) (v : V) : list (K * V) := match l with | [] => [(k, v)] | (k', v') :: l' => if K_eq_dec k k' then (k, v) :: l' else (k', v') :: (assoc_set l' k v) end. Fixpoint assoc_del (l : list (K * V)) (k : K) : list (K * V) := match l with | [] => [] | (k', v') :: l' => if K_eq_dec k k' then assoc_del l' k else (assoc_del l' k) end. Lemma get_set_diff : forall k k' v l, k <> k' -> assoc (assoc_set l k v) k' = assoc l k'. Proof using. induction l; intros; simpl; repeat (break_match; simpl); subst; try congruence; auto. Qed. Lemma get_del_same : forall k l, assoc (assoc_del l k) k = None. Proof using. induction l; intros; simpl in *. - auto. - repeat break_match; subst; simpl in *; auto. break_if; try congruence. Qed. Lemma get_set_diff_default : forall (k k' : K) (v : V) l d, k <> k' -> assoc_default (assoc_set l k v) k' d = assoc_default l k' d. Proof using. unfold assoc_default. intros. repeat break_match; auto; rewrite get_set_diff in * by auto; congruence. Qed. End assoc. coq-serapi-8.20.0-0.20.0/tests/fail/dune000066400000000000000000000002041466734233400173220ustar00rootroot00000000000000(rule (alias runtest) (deps (:input assoc.v)) (action (ignore-outputs (bash "! %{bin:sercomp} --mode=vo %{input}")))) coq-serapi-8.20.0-0.20.0/tests/genarg/000077500000000000000000000000001466734233400170005ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/tests/genarg/abstract.v000066400000000000000000000213211466734233400207710ustar00rootroot00000000000000Require Import ZArith. Definition outside_interval (a b : Z) := (Z.sgn a + Z.sgn b)%Z. Definition inside_interval_1 (o1 o2 : Z) := (0 < o1)%Z /\ (0 < o2)%Z \/ (o1 < 0)%Z /\ (o2 < 0)%Z. Definition inside_interval_2 (o1 o2 : Z) := (0 < o1)%Z /\ (o2 < 0)%Z \/ (o1 < 0)%Z /\ (0 < o2)%Z. Lemma inside_interval_1_dec_inf : forall o1 o2 : Z, {inside_interval_1 o1 o2} + {~ inside_interval_1 o1 o2}. Proof. intros. abstract (case (Z_lt_dec 0 o1); intro Ho1; [ case (Z_lt_dec 0 o2); intro Ho2; [ left; left; split | right; intro H; match goal with | id1:(~ ?X1) |- ?X2 => apply id1; case H; intros (H1, H2); [ idtac | apply False_ind; apply Z.lt_irrefl with o1; apply Z.lt_trans with 0%Z ] end ] | case (Z_lt_dec o1 0); intro Ho1'; [ case (Z_lt_dec o2 0); intro Ho2; [ left; right; split | right; intro H; case H; intros (H1, H2); [ apply Ho1 | apply Ho2 ] ] | right; intro H; apply Ho1; case H; intros (H1, H2); [ idtac | apply False_ind; apply Ho1' ] ] ]; try assumption). Defined. Lemma inside_interval_2_dec_inf : forall o1 o2 : Z, {inside_interval_2 o1 o2} + {~ inside_interval_2 o1 o2}. Proof. intros. abstract (case (Z_lt_dec 0 o1); intro Ho1; [ case (Z_lt_dec o2 0); intro Ho2; [ left; left; split | right; intro H; match goal with | id1:(~ ?X1) |- ?X2 => apply id1; case H; intros (H1, H2); [ idtac | apply False_ind; apply Z.lt_irrefl with o1; apply Z.lt_trans with 0%Z ] end ] | case (Z_lt_dec o1 0); intro Ho1'; [ case (Z_lt_dec 0 o2); intro Ho2; [ left; right; split | right; intro H; case H; intros (H1, H2); [ apply Ho1 | apply Ho2 ] ] | right; intro H; apply Ho1; case H; intros (H1, H2); [ idtac | apply False_ind; apply Ho1' ] ] ]; try assumption). Defined. Inductive Qpositive : Set := | nR : Qpositive -> Qpositive | dL : Qpositive -> Qpositive | One : Qpositive. Inductive Qhomographic_sg_denom_nonzero : Z -> Z -> Qpositive -> Prop := | Qhomographic_signok0 : forall (c d : Z) (p : Qpositive), p = One -> (c + d)%Z <> 0%Z -> Qhomographic_sg_denom_nonzero c d p | Qhomographic_signok1 : forall (c d : Z) (xs : Qpositive), Qhomographic_sg_denom_nonzero c (c + d)%Z xs -> Qhomographic_sg_denom_nonzero c d (nR xs) | Qhomographic_signok2 : forall (c d : Z) (xs : Qpositive), Qhomographic_sg_denom_nonzero (c + d)%Z d xs -> Qhomographic_sg_denom_nonzero c d (dL xs). Lemma Qhomographic_signok_1 : forall c d : Z, Qhomographic_sg_denom_nonzero c d One -> (c + d)%Z <> 0%Z. Proof. intros. inversion H. assumption. Defined. Lemma Qhomographic_signok_2 : forall (c d : Z) (xs : Qpositive), Qhomographic_sg_denom_nonzero c d (nR xs) -> Qhomographic_sg_denom_nonzero c (c + d) xs. Proof. intros. inversion H. discriminate H0. assumption. Defined. Lemma Qhomographic_signok_3 : forall (c d : Z) (xs : Qpositive), Qhomographic_sg_denom_nonzero c d (dL xs) -> Qhomographic_sg_denom_nonzero (c + d) d xs. Proof. intros. inversion H. discriminate H0. assumption. Defined. Fixpoint Qhomographic_sign (a b c d : Z) (p : Qpositive) {struct p} : forall (H_Qhomographic_sg_denom_nonzero : Qhomographic_sg_denom_nonzero c d p), Z * (Z * (Z * (Z * Z)) * Qpositive). set (o1 := outside_interval a b) in *. set (o2 := outside_interval c d) in *. destruct p as [q| q| ]; intros H_Qhomographic_sg_denom_nonzero. (* p=(nR xs) *) case (Z_zerop b). (* b=0 *) intro Hb. case (Z_zerop d). (* d=0 *) intro Hd. exact ((Z.sgn a * Z.sgn c)%Z, (a, (b, (c, d)), nR q)). (* d<>0 *) intro Hd'. case (Z_lt_dec 0 o2). (* `0 < o2` *) intro Ho2. exact (Z.sgn a, (a, (b, (c, d)), nR q)). (* ~( 00 *) intro Ho2''. exact (Qhomographic_sign a (a + b)%Z c (c + d)%Z q (Qhomographic_signok_2 c d q H_Qhomographic_sg_denom_nonzero)). (* b<>0 *) intro Hb. case (Z_zerop d). (* d=0 *) intro Hd. case (Z_lt_dec 0 o1). (* `0 < o1` *) intro Ho1. exact (Z.sgn c, (a, (b, (c, d)), nR q)). (* ~( 00 *) intro Ho1''. exact (Qhomographic_sign a (a + b)%Z c (c + d)%Z q (Qhomographic_signok_2 c d q H_Qhomographic_sg_denom_nonzero)). (* d<>0 *) intro Hd'. case (inside_interval_1_dec_inf o1 o2). (* (inside_interval_1 o1 o2) *) intro H_inside_1. exact (1%Z, (a, (b, (c, d)), nR q)). (* ~(inside_interval_1 o1 o2) *) intro H_inside_1'. case (inside_interval_2_dec_inf o1 o2). (* (inside_interval_2 o1 o2) *) intro H_inside_2. exact ((-1)%Z, (a, (b, (c, d)), nR q)). (* ~(inside_interval_1 o1 o2)/\~(inside_interval_2 o1 o2) *) intros H_inside_2'. exact (Qhomographic_sign a (a + b)%Z c (c + d)%Z q (Qhomographic_signok_2 c d q H_Qhomographic_sg_denom_nonzero)). (* p=(dL xs) *) case (Z_zerop b). (* b=0 *) intro Hb. case (Z_zerop d). (* d=0 *) intro Hd. exact ((Z.sgn a * Z.sgn c)%Z, (a, (b, (c, d)), dL q)). (* d<>0 *) intro Hd'. case (Z_lt_dec 0 o2). (* `0 < o2` *) intro Ho2. exact (Z.sgn a, (a, (b, (c, d)), dL q)). (* ~( 00 *) intro Ho2''. exact (Qhomographic_sign (a + b)%Z b (c + d)%Z d q (Qhomographic_signok_3 c d q H_Qhomographic_sg_denom_nonzero)). (* b<>0 *) intro Hb. case (Z_zerop d). (* d=0 *) intro Hd. case (Z_lt_dec 0 o1). (* `0 < o1` *) intro Ho1. exact (Z.sgn c, (a, (b, (c, d)), dL q)). (* ~( 00 *) intro Ho1''. exact (Qhomographic_sign (a + b)%Z b (c + d)%Z d q (Qhomographic_signok_3 c d q H_Qhomographic_sg_denom_nonzero)). (* d<>0 *) intro Hd'. case (inside_interval_1_dec_inf o1 o2). (* (inside_interval_1 o1 o2) *) intro H_inside_1. exact (1%Z, (a, (b, (c, d)), dL q)). (* ~(inside_interval_1 o1 o2) *) intro H_inside_1'. case (inside_interval_2_dec_inf o1 o2). (* (inside_interval_2 o1 o2) *) intro H_inside_2. exact ((-1)%Z, (a, (b, (c, d)), dL q)). (* ~(inside_interval_1 o1 o2)/\~(inside_interval_2 o1 o2) *) intros H_inside_2'. exact (Qhomographic_sign (a + b)%Z b (c + d)%Z d q (Qhomographic_signok_3 c d q H_Qhomographic_sg_denom_nonzero)). (* p = One *) set (soorat := Z.sgn (a + b)) in *. set (makhraj := Z.sgn (c + d)) in *. case (Z.eq_dec soorat 0). (* `soorat = 0` *) intro eq_numerator0. exact (0%Z, (a, (b, (c, d)), One)). (* `soorat <> 0` *) intro. case (Z.eq_dec soorat makhraj). (* soorat = makhraj *) intro. exact (1%Z, (a, (b, (c, d)), One)). (* soorat <> makhraj *) intro. exact ((-1)%Z, (a, (b, (c, d)), One)). Defined. Scheme Qhomographic_sg_denom_nonzero_inv_dep := Induction for Qhomographic_sg_denom_nonzero Sort Prop. Lemma Qhomographic_sign_equal : forall (a b c d : Z) (p : Qpositive) (H1 H2 : Qhomographic_sg_denom_nonzero c d p), Qhomographic_sign a b c d p H1 = Qhomographic_sign a b c d p H2. Proof. intros. generalize H2 H1 a b. intro. abstract let T_local := (intros; simpl in |- *; rewrite H; reflexivity) in (elim H0 using Qhomographic_sg_denom_nonzero_inv_dep; intros; [ destruct p0 as [q| q| ]; [ discriminate e | discriminate e | simpl in |- *; case (Z.eq_dec (Z.sgn (a0 + b0)) 0); case (Z.eq_dec (Z.sgn (a0 + b0)) (Z.sgn (c0 + d0))); intros; reflexivity ] | T_local | T_local ]). Defined. coq-serapi-8.20.0-0.20.0/tests/genarg/add_field.v000066400000000000000000000002401466734233400210560ustar00rootroot00000000000000Require Import Qfield. Add Field Qfield : Qsft (decidable Qeq_bool_eq, completeness Qeq_eq_bool, constants [Qcst], power_tac Qpower_theory [Qpow_tac]). coq-serapi-8.20.0-0.20.0/tests/genarg/auto.v000066400000000000000000000006151466734233400201410ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Section list_util. Variables A : Type. Lemma NoDup_app3_not_in_2 : forall (xs ys zs : list A) b, NoDup (xs ++ ys ++ b :: zs) -> In b ys -> False. Proof using. intros. rewrite <- app_ass in *. apply NoDup_remove_2 in H. rewrite app_ass in *. auto 10 with *. Qed. End list_util. coq-serapi-8.20.0-0.20.0/tests/genarg/case.v000066400000000000000000000002751466734233400201060ustar00rootroot00000000000000From Coq Require Import ssreflect. Structure stuff := Stuff { one : bool; two : nat }. Lemma stuff_one s b n : s = Stuff b n -> one s = b. Proof. by case: s => [b' n']; case =>->. Qed. coq-serapi-8.20.0-0.20.0/tests/genarg/clear.v000066400000000000000000000034151466734233400202600ustar00rootroot00000000000000Require Import List. Import ListNotations. Require Import Sumbool. Ltac break_let := match goal with | [ H : context [ (let (_,_) := ?X in _) ] |- _ ] => destruct X eqn:? | [ |- context [ (let (_,_) := ?X in _) ] ] => destruct X eqn:? end. Ltac find_injection := match goal with | [ H : ?X _ _ = ?X _ _ |- _ ] => injection H; intros; subst end. Ltac break_and := repeat match goal with | [H : _ /\ _ |- _ ] => destruct H end. Ltac break_if := match goal with | [ |- context [ if ?X then _ else _ ] ] => match type of X with | sumbool _ _ => destruct X | _ => destruct X eqn:? end end. Definition update2 {A B : Type} (A_eq_dec : forall x y : A, {x = y} + {x <> y}) (f : A -> A -> B) (x y : A) (v : B) := fun x' y' => if sumbool_and _ _ _ _ (A_eq_dec x x') (A_eq_dec y y') then v else f x' y'. Fixpoint collate {A B : Type} (A_eq_dec : forall x y : A, {x = y} + {x <> y}) (from : A) (f : A -> A -> list B) (ms : list (A * B)) := match ms with | [] => f | (to, m) :: ms' => collate A_eq_dec from (update2 A_eq_dec f from to (f from to ++ [m])) ms' end. Section Update2. Variables A B : Type. Hypothesis A_eq_dec : forall x y : A, {x = y} + {x <> y}. Lemma collate_f_eq : forall (f : A -> A -> list B) g h n n' l, f n n' = g n n' -> collate A_eq_dec h f l n n' = collate A_eq_dec h g l n n'. Proof using. intros f g h n n' l. generalize f g; clear f g. induction l; auto. intros. simpl in *. break_let. destruct a. find_injection. set (f' := update2 _ _ _ _ _). set (g' := update2 _ _ _ _ _). rewrite (IHl f' g'); auto. unfold f', g', update2. break_if; auto. break_and. subst. rewrite H. trivial. Qed. End Update2.coq-serapi-8.20.0-0.20.0/tests/genarg/dune000066400000000000000000000072471466734233400176700ustar00rootroot00000000000000; Eventually we should use the "put binaries in scope feature of Dune" (rule (targets test_roundtrip) (deps (:input test_roundtrip.in) ; For the plugins to be built, it'd be greater if we could only ; specify a few libs, but that's still not possible in Dune. (package coq-serapi)) (action (progn (copy test_roundtrip.in test_roundtrip) (run chmod +w test_roundtrip) ; We insert the digest of the binaries to force a rebuild of the ; test cases if the binary has been modified. (bash "for i in ../../sertop/sercomp.exe ../../serlib_8_20/plugins/*/*.cmxs; do echo \"# $(md5sum $i)\"; done >> test_roundtrip")))) (rule (alias runtest) (deps (:input abstract.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input add_field.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input auto.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input case.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input clear.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input eauto.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input elim.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input exact.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input exists.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input extraction.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input firstorder.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input fix.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input functional_induction.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input functional_scheme.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input hint_rewrite.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input instantiate.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input intropattern.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input intros.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input libTactics.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input mbid.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input move.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input now.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input rename.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input replace.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input revert.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input setoid_rewrite.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input specialize.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input subst.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input symmetry.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input tactic_notation.v)) (action (run ./test_roundtrip %{input}))) (rule (alias runtest) (deps (:input primitives.v)) (action (run ./test_roundtrip %{input}))) ; Disabled until we implement ltac2 extension serialization ; ; (rule ; (alias runtest) ; (deps (:input ltac2.v)) ; (action (run ./test_roundtrip %{input}))) coq-serapi-8.20.0-0.20.0/tests/genarg/eauto.v000066400000000000000000000011311466734233400203000ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Section list_util. Variables A : Type. Lemma in_firstn : forall n (x : A) xs, In x (firstn n xs) -> In x xs. Proof using. induction n; simpl; intuition. destruct xs;simpl in *; intuition. Qed. Lemma firstn_NoDup : forall n (xs : list A), NoDup xs -> NoDup (firstn n xs). Proof using. induction n; intros; simpl; destruct xs; auto. - apply NoDup_nil. - inversion H; subst. apply NoDup_cons. * eauto 6 using in_firstn. * apply IHn; auto. Qed. End list_util. coq-serapi-8.20.0-0.20.0/tests/genarg/elim.v000066400000000000000000000034541466734233400201230ustar00rootroot00000000000000Require Import ZArith. Require Import ZArith.Zmax. Require Import ssr.ssreflect. Open Scope Z_scope. Section BinaryTree. Inductive Tree : Set := | leaf : Tree | node : Tree -> Tree -> Tree. Definition max := Z.max. Fixpoint height (t : Tree) : Z := match t with | leaf => 0 | node t1 t2 => 1 + (max (height t1) (height t2)) end. Fixpoint numleaves (t : Tree) : Z := match t with | leaf => 1 | node t1 t2 => numleaves t1 + numleaves t2 end. Inductive complete : Tree -> Prop := | complete_leaf : complete leaf | complete_node : forall t1 t2, complete t1 -> complete t2 -> height t1 = height t2 -> complete (node t1 t2). Lemma height_nonnegative : forall t, height t >= 0. Proof. elim => //=. move => t1 Ht1 t2 Ht2. have H0: height (node t1 t2) = 1 + max (height t1) (height t2) by auto. have H1: height t1 <= max (height t1) (height t2) by apply Z.le_max_l. have H2: 1 + max (height t1) (height t2) >= 0 by auto with zarith. by []. Qed. Theorem complete_numleaves_height : forall t, complete t -> numleaves t = 2^(height t). Proof. elim => //=. move => t1 IHt1 t2 IHt2 Hc. have H1: complete t1 by inversion Hc. have H2: complete t2 by inversion Hc. have H3: (height t1 = height t2) by inversion Hc; auto. apply IHt1 in H1. apply IHt2 in H2. have H6: (1 >= 0) by intuition. have H7: (height t1 >= 0) by apply height_nonnegative. have H8: (height t1 = max (height t1) (height t1)) by erewrite Zmax_idempotent. simpl numleaves. rewrite H1 H2. rewrite -H3. have Hh: 2 ^ height t1 + 2 ^ height t1 = (2 * 2^(height t1)) by auto with zarith. rewrite Hh. have Hh': (2 * 2^(height t1)) = (2^1 * 2^(height t1)) by auto with zarith. rewrite Hh'. have Hh'': 2^(1 + height t1) = (2^1 * 2^(height t1)). by apply (Zpower_exp 2 1 (height t1) H6 H7). by rewrite -Hh'' {1}H8. Qed. End BinaryTree. coq-serapi-8.20.0-0.20.0/tests/genarg/exact.v000066400000000000000000000027561466734233400203050ustar00rootroot00000000000000Require Import String. Require Import Ascii. Require Import Orders. Inductive lex_lt: string -> string -> Prop := | lex_lt_lt : forall (c1 c2 : ascii) (s1 s2 : string), nat_of_ascii c1 < nat_of_ascii c2 -> lex_lt (String c1 s1) (String c2 s2) | lex_lt_eq : forall (c : ascii) (s1 s2 : string), lex_lt s1 s2 -> lex_lt (String c s1) (String c s2) | lex_lt_empty : forall (c : ascii) (s : string), lex_lt EmptyString (String c s). Theorem lex_lt_not_eq : forall s0 s1, lex_lt s0 s1 -> s0 <> s1. Proof. induction s0. - intros. inversion H; subst. congruence. - intros. inversion H; subst. * intro H_eq. injection H_eq; intros; subst. contradict H3. auto with arith. * intro H_eq. injection H_eq; intros; subst. specialize (IHs0 s3). apply IHs0 in H3. auto. Qed. Lemma lex_lt_irrefl : Irreflexive lex_lt. Proof. intros s0 H_lt. apply lex_lt_not_eq in H_lt. auto. Qed. Theorem lex_lt_trans : forall s0 s1 s2, lex_lt s0 s1 -> lex_lt s1 s2 -> lex_lt s0 s2. Proof. induction s0. - intros. inversion H; subst. inversion H0; subst. * apply lex_lt_empty. * apply lex_lt_empty. - intros. inversion H; subst; inversion H0; subst. * apply lex_lt_lt. eauto with arith. * apply lex_lt_lt. assumption. * apply lex_lt_lt. assumption. * apply lex_lt_eq. eapply IHs0; eauto. Qed. Theorem lex_lt_strorder : StrictOrder lex_lt. Proof. exact (Build_StrictOrder _ lex_lt_irrefl lex_lt_trans). Qed. coq-serapi-8.20.0-0.20.0/tests/genarg/exists.v000066400000000000000000000023011466734233400205020ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Fixpoint before {A: Type} (x : A) y l : Prop := match l with | [] => False | a :: l' => a = x \/ (a <> y /\ before x y l') end. Section before. Variable A : Type. Lemma before_In : forall x y l, before (A:=A) x y l -> In x l. Proof using. induction l; intros; simpl in *; intuition. Qed. Lemma before_split : forall l (x y : A), before x y l -> x <> y -> In x l -> In y l -> exists xs ys zs, l = xs ++ x :: ys ++ y :: zs. Proof using. induction l; intros; simpl in *; intuition; subst; try congruence. - exists []. simpl. apply in_split in H1. destruct H1; destruct H1. subst. eauto. - exists []. simpl. apply in_split in H1. destruct H1; destruct H1. subst. eauto. - exists []. simpl. apply in_split in H1. destruct H1; destruct H1. subst. eauto. - match goal with | [ H : context [ In ], H' : context [ In ] |- _ ] => eapply H in H' end; eauto. destruct H1; destruct H1; destruct H1. subst. exists (a :: x0), x1, x2. auto. Qed. End before.coq-serapi-8.20.0-0.20.0/tests/genarg/extraction.v000066400000000000000000000002531466734233400213470ustar00rootroot00000000000000Require Coq.extraction.Extraction. Extraction Language Haskell. Extraction Implicit pred [1]. Axiom Y : Set -> Set -> Set. Extract Constant Y "'a" "'b" => " 'a * 'b ". coq-serapi-8.20.0-0.20.0/tests/genarg/firstorder.v000066400000000000000000000033431466734233400213550ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Fixpoint fin (n : nat) : Type := match n with | 0 => False | S n' => option (fin n') end. Fixpoint fin_eq_dec (n : nat) : forall (a b : fin n), {a = b} + {a <> b}. refine (match n with | 0 => fun a b : fin 0 => right (match b with end) | S n' => fun a b : fin (S n') => match a, b with | Some a', Some b' => match fin_eq_dec n' a' b' with | left _ _ => left _ | right _ _ => right _ end | Some a', None => right _ | None, Some b' => right _ | None, None => left eq_refl end end); congruence. Defined. Fixpoint all_fin (n : nat) : list (fin n) := match n with | 0 => [] | S n' => None :: map (fun x => Some x) (all_fin n') end. Lemma all_fin_all : forall n (x : fin n), In x (all_fin n). Proof. induction n; intros. - inversion x. - simpl in *. destruct x; auto using in_map. Qed. Lemma NoDup_map_injective : forall A B (f : A -> B) xs, (forall x y, In x xs -> In y xs -> f x = f y -> x = y) -> NoDup xs -> NoDup (map f xs). Proof using. induction xs; intros. - constructor. - simpl. inversion H0. subst. constructor. + intro. apply in_map_iff in H1. destruct H1. destruct H1. assert (x = a) by intuition. subst. congruence. + intuition. Qed. Lemma all_fin_NoDup : forall n, NoDup (all_fin n). Proof. induction n; intros; simpl; constructor. - intro. apply in_map_iff in H. firstorder. discriminate. - apply NoDup_map_injective; auto. congruence. Qed.coq-serapi-8.20.0-0.20.0/tests/genarg/fix.v000066400000000000000000000034321466734233400177570ustar00rootroot00000000000000Require Import ZArith. Ltac Falsum := try intro; apply False_ind; repeat match goal with | id1:(~ ?X1) |- ?X2 => (apply id1; assumption || reflexivity) || clear id1 end. Inductive Qpositive : Set := | nR : Qpositive -> Qpositive | dL : Qpositive -> Qpositive | One : Qpositive. Inductive fractionalAcc : Z -> Z -> Prop := | fractionalacc0 : forall m n : Z, m = n -> fractionalAcc m n | fractionalacc1 : forall m n : Z, (0 < m)%Z -> (m < n)%Z -> fractionalAcc m (n - m)%Z -> fractionalAcc m n | fractionalacc2 : forall m n : Z, (0 < n)%Z -> (n < m)%Z -> fractionalAcc (m - n)%Z n -> fractionalAcc m n. Lemma fractionalacc_1 : forall m n : Z, fractionalAcc m n -> (0 < m)%Z -> (m < n)%Z -> fractionalAcc m (n - m). Proof. simple destruct 1; intros; trivial; Falsum; apply (Z.lt_irrefl n0); [ rewrite H0 in H2 | apply Z.lt_trans with m0 ]; assumption. Defined. Lemma fractionalacc_2 : forall m n : Z, fractionalAcc m n -> (0 < n)%Z -> (n < m)%Z -> fractionalAcc (m - n) n. Proof. simple destruct 1; intros; trivial; Falsum; apply (Z.lt_irrefl n0); [ rewrite H0 in H2 | apply Z.lt_trans with m0 ]; assumption. Defined. Definition encoding_algorithm : forall (x y : Z) (h1 : (0 < x)%Z) (h2 : (0 < y)%Z) (H : fractionalAcc x y), Qpositive. fix encoding_algorithm 5. intros x y h1 h2 H. refine match Z_dec' x y with | inleft H_x_neq_y => match H_x_neq_y with | left Hx_lt_y => dL (encoding_algorithm x (y - x)%Z h1 _ (fractionalacc_1 x y H h1 Hx_lt_y)) | right Hy_lt_x => nR (encoding_algorithm (x - y)%Z y _ h2 (fractionalacc_2 x y H h2 Hy_lt_x)) end | inright _ => One end; unfold Zminus in |- *; apply Zlt_left_lt; assumption. Defined. coq-serapi-8.20.0-0.20.0/tests/genarg/functional_induction.v000066400000000000000000000006721466734233400234120ustar00rootroot00000000000000Set Implicit Arguments. Require Import Arith. Require Import Recdef. Function ceil_log2_S (n: nat) {wf lt n}: nat := match n with | 0 => 0 | S _ => S (ceil_log2_S (Nat.div2 n)) end. Proof. intros. apply Nat.lt_div2; auto with arith. apply lt_wf. Defined. Lemma ceil_log2_S_def n: ceil_log2_S n = match n with | 0 => 0 | S _ => S (ceil_log2_S (Nat.div2 n)) end. Proof. functional induction (ceil_log2_S n); auto. Qed. coq-serapi-8.20.0-0.20.0/tests/genarg/functional_scheme.v000066400000000000000000000013101466734233400226500ustar00rootroot00000000000000Require Import FunInd. Require Import ZArith. Inductive Qpositive : Set := | nR : Qpositive -> Qpositive | dL : Qpositive -> Qpositive | One : Qpositive. Fixpoint Qpositive_c (p q n : nat) {struct n} : Qpositive := match n with | O => One | S n' => match p - q with | O => match q - p with | O => One | v => dL (Qpositive_c p v n') end | v => nR (Qpositive_c v q n') end end. Functional Scheme Qpositive_c_ind := Induction for Qpositive_c Sort Prop. Lemma Qpositive_c_0 : forall p q n : nat, n = 0 -> Qpositive_c p q n = One. Proof. intros p q n. functional induction (Qpositive_c p q n); trivial || (intros; discriminate). Qed. coq-serapi-8.20.0-0.20.0/tests/genarg/hint_rewrite.v000066400000000000000000000006341466734233400216750ustar00rootroot00000000000000Set Implicit Arguments. Section Definitions. Variables (A : Type). Implicit Types f g : A -> A -> A. Implicit Types i : A -> A. Definition involutive i := forall x, i (i x) = x. End Definitions. Definition neg (x:bool) : bool := match x with | true => false | false => true end. Lemma neg_neg : involutive neg. Proof. intros x. destruct x; auto. Qed. #[global] Hint Rewrite neg_neg : rew_neg_neg. coq-serapi-8.20.0-0.20.0/tests/genarg/instantiate.v000066400000000000000000000004341466734233400215130ustar00rootroot00000000000000Set Implicit Arguments. Require Import List. Section Filter. Variable A : Type. Lemma In_filter_In : forall (f : A -> bool) x l l', filter f l = l' -> In x l' -> In x l. Proof. intros. subst. eapply filter_In. instantiate (1 := f). assumption. Qed. End Filter. coq-serapi-8.20.0-0.20.0/tests/genarg/intropattern.v000066400000000000000000000043031466734233400217200ustar00rootroot00000000000000Inductive Qpositive : Set := | nR : Qpositive -> Qpositive | dL : Qpositive -> Qpositive | One : Qpositive. Fixpoint Qpositive_le_bool (w w' : Qpositive) {struct w'} : bool := match w with | One => match w' with | dL y => false | _ => true end | dL y => match w' with | dL y' => Qpositive_le_bool y y' | _ => true end | nR y => match w' with | nR y' => Qpositive_le_bool y y' | _ => false end end. Definition Qpositive_le (w w' : Qpositive) := Qpositive_le_bool w w' = true. Fixpoint Qpositive_i (w : Qpositive) : nat * nat := match w with | One => (1, 1) | nR w' => match Qpositive_i w' with | (p, q) => (p + q, q) end | dL w' => match Qpositive_i w' with | (p, q) => (p, p + q) end end. Fixpoint Qpositive_c (p q n : nat) {struct n} : Qpositive := match n with | O => One | S n' => match p - q with | O => match q - p with | O => One | v => dL (Qpositive_c p v n') end | v => nR (Qpositive_c v q n') end end. Definition Qpositive_sub (w w' : Qpositive) := let (p, q) := Qpositive_i w in let (p', q') := Qpositive_i w' in Qpositive_c (p * q' - p' * q) (q * q') (p * q' + p' * q + q * q'). Theorem interp_non_zero : forall w : Qpositive, exists p : nat, (exists q : nat, Qpositive_i w = (S p, S q)). simple induction w; simpl in |- *; (repeat exists 0; auto; fail) || (intros w' Hrec; elim Hrec; intros p' Hex; elim Hex; intros q' Heq; rewrite Heq). exists (p' + S q'); exists q'; auto. exists p'; exists (p' + S q'); auto. Qed. Ltac make_fraction w p q Heq := elim (interp_non_zero w); intros p (q, Heq). Theorem Qpositive_le_sub_l : forall w w' w'' : Qpositive, w <> w'' -> w' <> w'' -> Qpositive_le w w'' -> Qpositive_le w' w'' -> Qpositive_le w w' -> Qpositive_le (Qpositive_sub w'' w') (Qpositive_sub w'' w). Proof. intros w w' w''; make_fraction w ipattern:(p) ipattern:(q) ipattern:(Heq); make_fraction w' ipattern:(p') ipattern:(q') ipattern:(Heq'); make_fraction w'' ipattern:(p'') ipattern:(q'') ipattern:(Heq''); intros Hneq1 Hneq2. Admitted. coq-serapi-8.20.0-0.20.0/tests/genarg/intros.v000066400000000000000000000015461466734233400205130ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Section list_util. Variables A B : Type. Hypothesis A_eq_dec : forall x y : A, {x = y} + {x <> y}. Lemma In_cons_neq : forall a x xs, In(A:=A) a (x :: xs) -> a <> x -> In a xs. Proof using. simpl. intuition congruence. Qed. Lemma in_fold_left_by_cons_in : forall (l : list B) (g : B -> A) x acc, In x (fold_left (fun a b => g b :: a) l acc) -> In x acc \/ exists y, In y l /\ x = g y. Proof using A_eq_dec. intros until l. induction l. - auto. - simpl; intros. destruct (A_eq_dec x (g a)); subst. + right; exists a; tauto. + apply IHl in H. case H; [left|right]. * apply In_cons_neq in H0; tauto. * destruct H0; destruct H0. exists x0; split; auto. Qed. End list_util. coq-serapi-8.20.0-0.20.0/tests/genarg/libTactics.v000066400000000000000000005632561466734233400212710ustar00rootroot00000000000000(************************************************************************** * Useful General-Purpose Tactics for Coq * * Arthur Chargueraud * * Distributed under the terms of the LGPL-v3 license * ***************************************************************************) (** This file contains a set of tactics that extends the set of builtin tactics provided with the standard distribution of Coq. It intends to overcome a number of limitations of the standard set of tactics, and thereby to help user to write shorter and more robust scripts. Hopefully, Coq tactics will be improved as time goes by, and this file should ultimately be useless. In the meanwhile, serious Coq users will probably find it very useful. *) (** The main features offered are: - More convenient syntax for naming hypotheses, with tactics for introduction and inversion that take as input only the name of hypotheses of type [Prop], rather than the name of all variables. - Tactics providing true support for manipulating N-ary conjunctions, disjunctions and existentials, hidding the fact that the underlying implementation is based on binary propositions. - Convenient support for automation: tactic followed with the symbol "~" or "*" will call automation on the generated subgoals. The symbol "~" stands for [auto] and "*" for [intuition eauto]. These bindings can be customized. - Forward-chaining tactics are provided to instantiate lemmas either with variable or hypotheses or a mix of both. - A more powerful implementation of [apply] is provided (it is based on [refine] and thus behaves better with respect to conversion). - An improved inversion tactic which substitutes equalities on variables generated by the standard inversion mecanism. Moreover, it supports the elimination of dependently-typed equalities (requires axiom [K], which is a weak form of Proof Irrelevance). - Tactics for saving time when writing proofs, with tactics to asserts hypotheses or sub-goals, and improved tactics for clearing, renaming, and sorting hypotheses. *) (** External credits: - thanks to Xavier Leroy for providing the idea of tactic [forward], - thanks to Georges Gonthier for the implementation trick in [rapply], *) Set Implicit Arguments. Require Import Coq.Lists.List. (* ********************************************************************** *) (** * Fixing Stdlib *) (* Very important to remove hint trans_eq_bool from LibBool, otherwise eauto slows down dramatically: Lemma test : forall b, b = false. time eauto 7. (* takes over 4 seconds to fail! *) *) #[global] Remove Hints Bool.trans_eq_bool. (* ********************************************************************** *) (** * Tools for programming with Ltac *) (* ---------------------------------------------------------------------- *) (** ** Identity continuation *) Ltac idcont tt := idtac. (* ---------------------------------------------------------------------- *) (** ** Untyped arguments for tactics *) (** Any Coq value can be boxed into the type [Boxer]. This is useful to use Coq computations for implementing tactics. *) Inductive Boxer : Type := | boxer : forall (A:Type), A -> Boxer. (* ---------------------------------------------------------------------- *) (** ** Optional arguments for tactics *) (** [ltac_no_arg] is a constant that can be used to simulate optional arguments in tactic definitions. Use [mytactic ltac_no_arg] on the tactic invokation, and use [match arg with ltac_no_arg => ..] or [match type of arg with ltac_No_arg => ..] to test whether an argument was provided. *) Inductive ltac_No_arg : Set := | ltac_no_arg : ltac_No_arg. (* ---------------------------------------------------------------------- *) (** ** Wildcard arguments for tactics *) (** [ltac_wild] is a constant that can be used to simulate wildcard arguments in tactic definitions. Notation is [__]. *) Inductive ltac_Wild : Set := | ltac_wild : ltac_Wild. Notation "'__'" := ltac_wild : ltac_scope. (** [ltac_wilds] is another constant that is typically used to simulate a sequence of [N] wildcards, with [N] chosen appropriately depending on the context. Notation is [___]. *) Inductive ltac_Wilds : Set := | ltac_wilds : ltac_Wilds. Notation "'___'" := ltac_wilds : ltac_scope. Open Scope ltac_scope. (* ---------------------------------------------------------------------- *) (** ** Position markers *) (** [ltac_Mark] and [ltac_mark] are dummy definitions used as sentinel by tactics, to mark a certain position in the context or in the goal. *) Inductive ltac_Mark : Type := | ltac_mark : ltac_Mark. (** [gen_until_mark] repeats [generalize] on hypotheses from the context, starting from the bottom and stopping as soon as reaching an hypothesis of type [Mark]. If fails if [Mark] does not appear in the context. *) Ltac gen_until_mark := match goal with H: ?T |- _ => match T with | ltac_Mark => clear H | _ => generalize H; clear H; gen_until_mark end end. (** [gen_until_mark_with_processing F] is similar to [gen_until_mark] except that it calls [F] on each hypothesis immediately before generalizing it. This is useful for processing the hypotheses. *) Ltac gen_until_mark_with_processing cont := match goal with H: ?T |- _ => match T with | ltac_Mark => clear H | _ => cont H; generalize H; clear H; gen_until_mark_with_processing cont end end. (** [intro_until_mark] repeats [intro] until reaching an hypothesis of type [Mark]. It throws away the hypothesis [Mark]. It fails if [Mark] does not appear as an hypothesis in the goal. *) Ltac intro_until_mark := match goal with | |- (ltac_Mark -> _) => intros _ | _ => intro; intro_until_mark end. (* ---------------------------------------------------------------------- *) (** ** List of arguments for tactics *) (** A datatype of type [list Boxer] is used to manipulate list of Coq values in ltac. Notation is [>> v1 v2 ... vN] for building a list containing the values [v1] through [vN]. *) Notation "'>>'" := (@nil Boxer) (at level 0) : ltac_scope. Notation "'>>' v1" := ((boxer v1)::nil) (at level 0, v1 at level 0) : ltac_scope. Notation "'>>' v1 v2" := ((boxer v1)::(boxer v2)::nil) (at level 0, v1 at level 0, v2 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3" := ((boxer v1)::(boxer v2)::(boxer v3)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6 v7" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::(boxer v7)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::(boxer v7)::(boxer v8)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0, v8 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0, v8 at level 0, v9 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0, v8 at level 0, v9 at level 0, v10 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10) ::(boxer v11)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0, v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10) ::(boxer v11)::(boxer v12)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0, v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0, v12 at level 0) : ltac_scope. Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13" := ((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5) ::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10) ::(boxer v11)::(boxer v12)::(boxer v13)::nil) (at level 0, v1 at level 0, v2 at level 0, v3 at level 0, v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0, v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0, v12 at level 0, v13 at level 0) : ltac_scope. (** The tactic [list_boxer_of] inputs a term [E] and returns a term of type "list boxer", according to the following rules: - if [E] is already of type "list Boxer", then it returns [E]; - otherwise, it returns the list [(boxer E)::nil]. *) Ltac list_boxer_of E := match type of E with | List.list Boxer => constr:(E) | _ => constr:((boxer E)::nil) end. (* ---------------------------------------------------------------------- *) (** ** Databases of lemmas *) (** Use the hint facility to implement a database mapping terms to terms. To declare a new database, use a definition: [Definition mydatabase := True.] Then, to map [mykey] to [myvalue], write the hint: [Hint Extern 1 (Register mydatabase mykey) => Provide myvalue.] Finally, to query the value associated with a key, run the tactic [ltac_database_get mydatabase mykey]. This will leave at the head of the goal the term [myvalue]. It can then be named and exploited using [intro]. *) Inductive Ltac_database_token : Prop := ltac_database_token. Definition ltac_database (D:Boxer) (T:Boxer) (A:Boxer) := Ltac_database_token. Notation "'Register' D T" := (ltac_database (boxer D) (boxer T) _) (at level 69, D at level 0, T at level 0). Lemma ltac_database_provide : forall (A:Boxer) (D:Boxer) (T:Boxer), ltac_database D T A. Proof using. split. Qed. Ltac Provide T := apply (@ltac_database_provide (boxer T)). Ltac ltac_database_get D T := let A := fresh "TEMP" in evar (A:Boxer); let H := fresh "TEMP" in assert (H : ltac_database (boxer D) (boxer T) A); [ subst A; auto | subst A; match type of H with ltac_database _ _ (boxer ?L) => generalize L end; clear H ]. (* Note for a possible alternative implementation of the ltac_database_token: Inductive Ltac_database : Type := | ltac_database : forall A, A -> Ltac_database. Implicit Arguments ltac_database [A]. *) (* ---------------------------------------------------------------------- *) (** ** On-the-fly removal of hypotheses *) (** In a list of arguments [>> H1 H2 .. HN] passed to a tactic such as [lets] or [applys] or [forwards] or [specializes], the term [rm], an identity function, can be placed in front of the name of an hypothesis to be deleted. *) Definition rm (A:Type) (X:A) := X. (** [rm_term E] removes one hypothesis that admits the same type as [E]. *) Ltac rm_term E := let T := type of E in match goal with H: T |- _ => try clear H end. (** [rm_inside E] calls [rm_term Ei] for any subterm of the form [rm Ei] found in E *) Ltac rm_inside E := let go E := rm_inside E in match E with | rm ?X => rm_term X | ?X1 ?X2 => go X1; go X2 | ?X1 ?X2 ?X3 => go X1; go X2; go X3 | ?X1 ?X2 ?X3 ?X4 => go X1; go X2; go X3; go X4 | ?X1 ?X2 ?X3 ?X4 ?X5 => go X1; go X2; go X3; go X4; go X5 | ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 => go X1; go X2; go X3; go X4; go X5; go X6 | ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 => go X1; go X2; go X3; go X4; go X5; go X6; go X7 | ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 => go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8 | ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 ?X9 => go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8; go X9 | ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 ?X9 ?X10 => go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8; go X9; go X10 | _ => idtac end. (** For faster performance, one may deactivate [rm_inside] by replacing the body of this definition with [idtac]. *) Ltac fast_rm_inside E := rm_inside E. (* ---------------------------------------------------------------------- *) (** ** Numbers as arguments *) (** When tactic takes a natural number as argument, it may be parsed either as a natural number or as a relative number. In order for tactics to convert their arguments into natural numbers, we provide a conversion tactic. Note: the tactic [number_to_nat] is extended in [LibInt] to take into account the [int] type, alias for [Z]. *) Require Coq.Numbers.BinNums Coq.ZArith.BinInt. Definition ltac_int_to_nat (x:BinInt.Z) : nat := match x with | BinInt.Z0 => 0%nat | BinInt.Zpos p => BinPos.nat_of_P p | BinInt.Zneg p => 0%nat end. Ltac number_to_nat N := match type of N with | nat => constr:(N) | BinInt.Z => let N' := constr:(ltac_int_to_nat N) in eval compute in N' end. (** [ltac_pattern E at K] is the same as [pattern E at K] except that [K] is a Coq number (nat or Z) rather than a Ltac integer. Syntax [ltac_pattern E as K in H] is also available. *) Tactic Notation "ltac_pattern" constr(E) "at" constr(K) := match number_to_nat K with | 1 => pattern E at 1 | 2 => pattern E at 2 | 3 => pattern E at 3 | 4 => pattern E at 4 | 5 => pattern E at 5 | 6 => pattern E at 6 | 7 => pattern E at 7 | 8 => pattern E at 8 | _ => fail "ltac_pattern: arity not supported" end. Tactic Notation "ltac_pattern" constr(E) "at" constr(K) "in" hyp(H) := match number_to_nat K with | 1 => pattern E at 1 in H | 2 => pattern E at 2 in H | 3 => pattern E at 3 in H | 4 => pattern E at 4 in H | 5 => pattern E at 5 in H | 6 => pattern E at 6 in H | 7 => pattern E at 7 in H | 8 => pattern E at 8 in H | _ => fail "ltac_pattern: arity not supported" end. (** [ltac_set (x := E) at K] is the same as [set (x := E) at K] except that [K] is a Coq number (nat or Z) rather than a Ltac integer. *) Tactic Notation "ltac_set" "(" ident(X) ":=" constr(E) ")" "at" constr(K) := match number_to_nat K with | 1%nat => set (X := E) at 1 | 2%nat => set (X := E) at 2 | 3%nat => set (X := E) at 3 | 4%nat => set (X := E) at 4 | 5%nat => set (X := E) at 5 | 6%nat => set (X := E) at 6 | 7%nat => set (X := E) at 7 | 8%nat => set (X := E) at 8 | 9%nat => set (X := E) at 9 | 10%nat => set (X := E) at 10 | 11%nat => set (X := E) at 11 | 12%nat => set (X := E) at 12 | 13%nat => set (X := E) at 13 | _ => fail "ltac_set: arity not supported" end. (* ---------------------------------------------------------------------- *) (** ** Testing tactics *) (** [show tac] executes a tactic [tac] that produces a result, and then display its result. *) Tactic Notation "show" tactic(tac) := let R := tac in pose R. (** [dup N] produces [N] copies of the current goal. It is useful for building examples on which to illustrate behaviour of tactics. [dup] is short for [dup 2]. *) Lemma dup_lemma : forall P, P -> P -> P. Proof using. auto. Qed. Ltac dup_tactic N := match number_to_nat N with | 0 => idtac | S 0 => idtac | S ?N' => apply dup_lemma; [ | dup_tactic N' ] end. Tactic Notation "dup" constr(N) := dup_tactic N. Tactic Notation "dup" := dup 2. (* ---------------------------------------------------------------------- *) (** ** Testing evars and non-evars *) (** [is_not_evar E] succeeds only if [E] is not an evar; it fails otherwise. It thus implements the negation of [is_evar] *) Ltac is_not_evar E := first [ is_evar E; fail 1 | idtac ]. (** [is_evar_as_bool E] evaluates to [true] if [E] is an evar and to [false] otherwise. *) Ltac is_evar_as_bool E := constr:(ltac:(first [ is_evar E; exact true | exact false ])). (* ---------------------------------------------------------------------- *) (** ** Check no evar in goal *) Ltac check_noevar M := first [ has_evar M; fail 2 | idtac ]. Ltac check_noevar_hyp H := let T := type of H in check_noevar T. Ltac check_noevar_goal := match goal with |- ?G => check_noevar G end. (* ---------------------------------------------------------------------- *) (** ** Helper function for introducing evars *) (** [with_evar T (fun M => tac)] creates a new evar that can be used in the tactic [tac] under the name [M]. *) Ltac with_evar_base T cont := let x := fresh "TEMP" in evar (x:T); cont x; subst x. Tactic Notation "with_evar" constr(T) tactic(cont) := with_evar_base T cont. (* ---------------------------------------------------------------------- *) (** ** Tagging of hypotheses *) (** [get_last_hyp tt] is a function that returns the last hypothesis at the bottom of the context. It is useful to obtain the default name associated with the hypothesis, e.g. [intro; let H := get_last_hyp tt in let H' := fresh "P" H in ...] *) Ltac get_last_hyp tt := match goal with H: _ |- _ => constr:(H) end. (* ---------------------------------------------------------------------- *) (** ** Tagging of hypotheses *) (** [ltac_tag_subst] is a specific marker for hypotheses which is used to tag hypotheses that are equalities to be substituted. *) Definition ltac_tag_subst (A:Type) (x:A) := x. (** [ltac_to_generalize] is a specific marker for hypotheses to be generalized. *) Definition ltac_to_generalize (A:Type) (x:A) := x. Ltac gen_to_generalize := repeat match goal with H: ltac_to_generalize _ |- _ => generalize H; clear H end. Ltac mark_to_generalize H := let T := type of H in change T with (ltac_to_generalize T) in H. (* ---------------------------------------------------------------------- *) (** ** Deconstructing terms *) (** [get_head E] is a tactic that returns the head constant of the term [E], ie, when applied to a term of the form [P x1 ... xN] it returns [P]. If [E] is not an application, it returns [E]. Warning: the tactic seems to loop in some cases when the goal is a product and one uses the result of this function. *) Ltac get_head E := match E with | ?P _ _ _ _ _ _ _ _ _ _ _ _ => constr:(P) | ?P _ _ _ _ _ _ _ _ _ _ _ => constr:(P) | ?P _ _ _ _ _ _ _ _ _ _ => constr:(P) | ?P _ _ _ _ _ _ _ _ _ => constr:(P) | ?P _ _ _ _ _ _ _ _ => constr:(P) | ?P _ _ _ _ _ _ _ => constr:(P) | ?P _ _ _ _ _ _ => constr:(P) | ?P _ _ _ _ _ => constr:(P) | ?P _ _ _ _ => constr:(P) | ?P _ _ _ => constr:(P) | ?P _ _ => constr:(P) | ?P _ => constr:(P) | ?P => constr:(P) end. (** [get_fun_arg E] is a tactic that decomposes an application term [E], ie, when applied to a term of the form [X1 ... XN] it returns a pair made of [X1 .. X(N-1)] and [XN]. *) Ltac get_fun_arg E := match E with | ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X => constr:((X1 X2 X3 X4 X5 X6 X7,X)) | ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X => constr:((X1 X2 X3 X4 X5 X6,X)) | ?X1 ?X2 ?X3 ?X4 ?X5 ?X => constr:((X1 X2 X3 X4 X5,X)) | ?X1 ?X2 ?X3 ?X4 ?X => constr:((X1 X2 X3 X4,X)) | ?X1 ?X2 ?X3 ?X => constr:((X1 X2 X3,X)) | ?X1 ?X2 ?X => constr:((X1 X2,X)) | ?X1 ?X => constr:((X1,X)) end. (* ---------------------------------------------------------------------- *) (** ** Action at occurence and action not at occurence *) (** [ltac_action_at K of E do Tac] isolates the [K]-th occurence of [E] in the goal, setting it in the form [P E] for some named pattern [P], then calls tactic [Tac], and finally unfolds [P]. Syntax [ltac_action_at K of E in H do Tac] is also available. *) Tactic Notation "ltac_action_at" constr(K) "of" constr(E) "do" tactic(Tac) := let p := fresh "TEMP" in ltac_pattern E at K; match goal with |- ?P _ => set (p:=P) end; Tac; unfold p; clear p. Tactic Notation "ltac_action_at" constr(K) "of" constr(E) "in" hyp(H) "do" tactic(Tac) := let p := fresh "TEMP" in ltac_pattern E at K in H; match type of H with ?P _ => set (p:=P) in H end; Tac; unfold p in H; clear p. (** [protects E do Tac] temporarily assigns a name to the expression [E] so that the execution of tactic [Tac] will not modify [E]. This is useful for instance to restrict the action of [simpl]. *) Tactic Notation "protects" constr(E) "do" tactic(Tac) := (* let x := fresh "TEMP" in sets_eq x: E; T; subst x. *) let x := fresh "TEMP" in let H := fresh "TEMP" in set (X := E) in *; assert (H : X = E) by reflexivity; clearbody X; Tac; subst x. Tactic Notation "protects" constr(E) "do" tactic(Tac) "/" := protects E do Tac. (* ---------------------------------------------------------------------- *) (** ** An alias for [eq] *) (** [eq'] is an alias for [eq] to be used for equalities in inductive definitions, so that they don't get mixed with equalities generated by [inversion]. *) Definition eq' := @eq. #[global] Hint Unfold eq'. Notation "x '='' y" := (@eq' _ x y) (at level 70, y at next level). (* ********************************************************************** *) (** * Common tactics for simplifying goals like [intuition] *) Ltac jauto_set_hyps := repeat match goal with H: ?T |- _ => match T with | _ /\ _ => destruct H | exists a, _ => destruct H | _ => generalize H; clear H end end. Ltac jauto_set_goal := repeat match goal with | |- exists a, _ => esplit | |- _ /\ _ => split end. Ltac jauto_set := intros; jauto_set_hyps; intros; jauto_set_goal; unfold not in *. (* ********************************************************************** *) (** * Backward and forward chaining *) (* ---------------------------------------------------------------------- *) (** ** Application *) Ltac old_refine f := refine f. (* ; shelve_unifiable. *) (** [rapply] is a tactic similar to [eapply] except that it is based on the [refine] tactics, and thus is strictly more powerful (at least in theory :). In short, it is able to perform on-the-fly conversions when required for arguments to match, and it is able to instantiate existentials when required. *) Tactic Notation "rapply" constr(t) := first (* --TODO: the @ are not useful *) [ eexact (@t) | old_refine (@t) | old_refine (@t _) | old_refine (@t _ _) | old_refine (@t _ _ _) | old_refine (@t _ _ _ _) | old_refine (@t _ _ _ _ _) | old_refine (@t _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _ _ _ _ _ _ _) | old_refine (@t _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) ]. (** The tactics [applys_N T], where [N] is a natural number, provides a more efficient way of using [applys T]. It avoids trying out all possible arities, by specifying explicitely the arity of function [T]. *) Tactic Notation "rapply_0" constr(t) := old_refine (@t). Tactic Notation "rapply_1" constr(t) := old_refine (@t _). Tactic Notation "rapply_2" constr(t) := old_refine (@t _ _). Tactic Notation "rapply_3" constr(t) := old_refine (@t _ _ _). Tactic Notation "rapply_4" constr(t) := old_refine (@t _ _ _ _). Tactic Notation "rapply_5" constr(t) := old_refine (@t _ _ _ _ _). Tactic Notation "rapply_6" constr(t) := old_refine (@t _ _ _ _ _ _). Tactic Notation "rapply_7" constr(t) := old_refine (@t _ _ _ _ _ _ _). Tactic Notation "rapply_8" constr(t) := old_refine (@t _ _ _ _ _ _ _ _). Tactic Notation "rapply_9" constr(t) := old_refine (@t _ _ _ _ _ _ _ _ _). Tactic Notation "rapply_10" constr(t) := old_refine (@t _ _ _ _ _ _ _ _ _ _). (** [lets_base H E] adds an hypothesis [H : T] to the context, where [T] is the type of term [E]. If [H] is an introduction pattern, it will destruct [H] according to the pattern. *) Ltac lets_base I E := generalize E; intros I. (** [applys_to H E] transform the type of hypothesis [H] by replacing it by the result of the application of the term [E] to [H]. Intuitively, it is equivalent to [lets H: (E H)]. *) Tactic Notation "applys_to" hyp(H) constr(E) := let H' := fresh "TEMP" in rename H into H'; (first [ lets_base H (E H') | lets_base H (E _ H') | lets_base H (E _ _ H') | lets_base H (E _ _ _ H') | lets_base H (E _ _ _ _ H') | lets_base H (E _ _ _ _ _ H') | lets_base H (E _ _ _ _ _ _ H') | lets_base H (E _ _ _ _ _ _ _ H') | lets_base H (E _ _ _ _ _ _ _ _ H') | lets_base H (E _ _ _ _ _ _ _ _ _ H') ] ); clear H'. (** [applys_to H1,...,HN E] applys [E] to several hypotheses *) Tactic Notation "applys_to" hyp(H1) "," hyp(H2) constr(E) := applys_to H1 E; applys_to H2 E. Tactic Notation "applys_to" hyp(H1) "," hyp(H2) "," hyp(H3) constr(E) := applys_to H1 E; applys_to H2 E; applys_to H3 E. Tactic Notation "applys_to" hyp(H1) "," hyp(H2) "," hyp(H3) "," hyp(H4) constr(E) := applys_to H1 E; applys_to H2 E; applys_to H3 E; applys_to H4 E. (** [constructors] calls [constructor] or [econstructor]. *) Tactic Notation "constructors" := first [ constructor | econstructor ]; unfold eq'. (* ---------------------------------------------------------------------- *) (** ** Assertions *) (** [asserts H: T] is another syntax for [assert (H : T)], which also works with introduction patterns. For instance, one can write: [asserts \[x P\] (exists n, n = 3)], or [asserts \[H|H\] (n = 0 \/ n = 1). *) Tactic Notation "asserts" simple_intropattern(I) ":" constr(T) := let H := fresh "TEMP" in assert (H : T); [ | generalize H; clear H; intros I ]. (** [asserts H1 .. HN: T] is a shorthand for [asserts \[H1 \[H2 \[.. HN\]\]\]\]: T]. *) Tactic Notation "asserts" simple_intropattern(I1) simple_intropattern(I2) ":" constr(T) := asserts [I1 I2]: T. Tactic Notation "asserts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) := asserts [I1 [I2 I3]]: T. Tactic Notation "asserts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) ":" constr(T) := asserts [I1 [I2 [I3 I4]]]: T. Tactic Notation "asserts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) := asserts [I1 [I2 [I3 [I4 I5]]]]: T. Tactic Notation "asserts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) ":" constr(T) := asserts [I1 [I2 [I3 [I4 [I5 I6]]]]]: T. (** [asserts: T] is [asserts H: T] with [H] being chosen automatically. *) Tactic Notation "asserts" ":" constr(T) := let H := fresh "TEMP" in asserts H : T. (** [cuts H: T] is the same as [asserts H: T] except that the two subgoals generated are swapped: the subgoal [T] comes second. Note that contrary to [cut], it introduces the hypothesis. *) Tactic Notation "cuts" simple_intropattern(I) ":" constr(T) := cut (T); [ intros I | idtac ]. (** [cuts: T] is [cuts H: T] with [H] being chosen automatically. *) Tactic Notation "cuts" ":" constr(T) := let H := fresh "TEMP" in cuts H: T. (** [cuts H1 .. HN: T] is a shorthand for [cuts \[H1 \[H2 \[.. HN\]\]\]\]: T]. *) Tactic Notation "cuts" simple_intropattern(I1) simple_intropattern(I2) ":" constr(T) := cuts [I1 I2]: T. Tactic Notation "cuts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) := cuts [I1 [I2 I3]]: T. Tactic Notation "cuts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) ":" constr(T) := cuts [I1 [I2 [I3 I4]]]: T. Tactic Notation "cuts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) := cuts [I1 [I2 [I3 [I4 I5]]]]: T. Tactic Notation "cuts" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) ":" constr(T) := cuts [I1 [I2 [I3 [I4 [I5 I6]]]]]: T. (* ---------------------------------------------------------------------- *) (** ** Instantiation and forward-chaining *) (** The instantiation tactics are used to instantiate a lemma [E] (whose type is a product) on some arguments. The type of [E] is made of implications and universal quantifications, e.g. [forall x, P x -> forall y z, Q x y z -> R z]. The first possibility is to provide arguments in order: first [x], then a proof of [P x], then [y] etc... In this mode, called "Args", all the arguments are to be provided. If a wildcard is provided (written [__]), then an existential variable will be introduced in place of the argument. It is very convenient to give some arguments the lemma should be instantiated on, and let the tactic find out automatically where underscores should be insterted. Underscore arguments [__] are interpret as follows: an underscore means that we want to skip the argument that has the same type as the next real argument provided (real means not an underscore). If there is no real argument after underscore, then the underscore is used for the first possible argument. The general syntax is [tactic (>> E1 .. EN)] where [tactic] is the name of the tactic (possibly with some arguments) and [Ei] are the arguments. Moreover, some tactics accept the syntax [tactic E1 .. EN] as short for [tactic (>> E1 .. EN)] for values of [N] up to 5. Finally, if the argument [EN] given is a triple-underscore [___], then it is equivalent to providing a list of wildcards, with the appropriate number of wildcards. This means that all the remaining arguments of the lemma will be instantiated. Definitions in the conclusion are not unfolded in this case. *) (* Underlying implementation *) Ltac app_assert t P cont := let H := fresh "TEMP" in assert (H : P); [ | cont(t H); clear H ]. Ltac app_evar t A cont := let x := fresh "TEMP" in evar (x:A); let t' := constr:(t x) in let t'' := (eval unfold x in t') in subst x; cont t''. Ltac app_arg t P v cont := let H := fresh "TEMP" in assert (H : P); [ apply v | cont(t H); try clear H ]. Ltac build_app_alls t final := let rec go t := match type of t with | ?P -> ?Q => app_assert t P go | forall _:?A, _ => app_evar t A go | _ => final t end in go t. Ltac boxerlist_next_type vs := match vs with | nil => constr:(ltac_wild) | (boxer ltac_wild)::?vs' => boxerlist_next_type vs' | (boxer ltac_wilds)::_ => constr:(ltac_wild) | (@boxer ?T _)::_ => constr:(T) end. (* Note: refuse to instantiate a dependent hypothesis with a proposition; refuse to instantiate an argument of type Type with one that does not have the type Type. *) Ltac build_app_hnts t vs final := let rec go t vs := match vs with | nil => first [ final t | fail 1 ] | (boxer ltac_wilds)::_ => first [ build_app_alls t final | fail 1 ] | (boxer ?v)::?vs' => let cont t' := go t' vs in let cont' t' := go t' vs' in let T := type of t in let T := eval hnf in T in match v with | ltac_wild => first [ let U := boxerlist_next_type vs' in match U with | ltac_wild => match T with | ?P -> ?Q => first [ app_assert t P cont' | fail 3 ] | forall _:?A, _ => first [ app_evar t A cont' | fail 3 ] end | _ => match T with (* should test T for unifiability *) | U -> ?Q => first [ app_assert t U cont' | fail 3 ] | forall _:U, _ => first [ app_evar t U cont' | fail 3 ] | ?P -> ?Q => first [ app_assert t P cont | fail 3 ] | forall _:?A, _ => first [ app_evar t A cont | fail 3 ] end end | fail 2 ] | _ => match T with | ?P -> ?Q => first [ app_arg t P v cont' | app_assert t P cont | fail 3 ] | forall _:Type, _ => match type of v with | Type => first [ cont' (t v) | app_evar t Type cont | fail 3 ] | _ => first [ app_evar t Type cont | fail 3 ] end | forall _:?A, _ => let V := type of v in match type of V with | Prop => first [ app_evar t A cont | fail 3 ] | _ => first [ cont' (t v) | app_evar t A cont | fail 3 ] end end end end in go t vs. (** newer version : support for typeclasses *) Ltac app_typeclass t cont := let t' := constr:(t _) in cont t'. Ltac build_app_alls t final ::= let rec go t := match type of t with | ?P -> ?Q => app_assert t P go | forall _:?A, _ => first [ app_evar t A go | app_typeclass t go | fail 3 ] | _ => final t end in go t. Ltac build_app_hnts t vs final ::= let rec go t vs := match vs with | nil => first [ final t | fail 1 ] | (boxer ltac_wilds)::_ => first [ build_app_alls t final | fail 1 ] | (boxer ?v)::?vs' => let cont t' := go t' vs in let cont' t' := go t' vs' in let T := type of t in let T := eval hnf in T in match v with | ltac_wild => first [ let U := boxerlist_next_type vs' in match U with | ltac_wild => match T with | ?P -> ?Q => first [ app_assert t P cont' | fail 3 ] | forall _:?A, _ => first [ app_typeclass t cont' | app_evar t A cont' | fail 3 ] end | _ => match T with (* should test T for unifiability *) | U -> ?Q => first [ app_assert t U cont' | fail 3 ] | forall _:U, _ => first [ app_typeclass t cont' | app_evar t U cont' | fail 3 ] | ?P -> ?Q => first [ app_assert t P cont | fail 3 ] | forall _:?A, _ => first [ app_typeclass t cont | app_evar t A cont | fail 3 ] end end | fail 2 ] | _ => match T with | ?P -> ?Q => first [ app_arg t P v cont' | app_assert t P cont | fail 3 ] | forall _:Type, _ => match type of v with | Type => first [ cont' (t v) | app_evar t Type cont | fail 3 ] | _ => first [ app_evar t Type cont | fail 3 ] end | forall _:?A, _ => let V := type of v in match type of V with | Prop => first [ app_typeclass t cont | app_evar t A cont | fail 3 ] | _ => first [ cont' (t v) | app_typeclass t cont | app_evar t A cont | fail 3 ] end end end end in go t vs. (* --TODO: use local function for first [...] *) (*--old version Ltac build_app_hnts t vs final := let rec go t vs := match vs with | nil => first [ final t | fail 1 ] | (boxer ltac_wilds)::_ => first [ build_app_alls t final | fail 1 ] | (boxer ?v)::?vs' => let cont t' := go t' vs in let cont' t' := go t' vs' in let T := type of t in let T := eval hnf in T in match v with | ltac_wild => first [ let U := boxerlist_next_type vs' in match U with | ltac_wild => match T with | ?P -> ?Q => first [ app_assert t P cont' | fail 3 ] | forall _:?A, _ => first [ app_evar t A cont' | fail 3 ] end | _ => match T with (* should test T for unifiability *) | U -> ?Q => first [ app_assert t U cont' | fail 3 ] | forall _:U, _ => first [ app_evar t U cont' | fail 3 ] | ?P -> ?Q => first [ app_assert t P cont | fail 3 ] | forall _:?A, _ => first [ app_evar t A cont | fail 3 ] end end | fail 2 ] | _ => match T with | ?P -> ?Q => first [ app_arg t P v cont' | app_assert t P cont | fail 3 ] | forall _:?A, _ => first [ cont' (t v) | app_evar t A cont | fail 3 ] end end end in go t vs. *) Ltac build_app args final := first [ match args with (@boxer ?T ?t)::?vs => let t := constr:(t:T) in build_app_hnts t vs final; fast_rm_inside args end | fail 1 "Instantiation fails for:" args]. Ltac unfold_head_until_product T := eval hnf in T. Ltac args_unfold_head_if_not_product args := match args with (@boxer ?T ?t)::?vs => let T' := unfold_head_until_product T in constr:((@boxer T' t)::vs) end. Ltac args_unfold_head_if_not_product_but_params args := match args with | (boxer ?t)::(boxer ?v)::?vs => args_unfold_head_if_not_product args | _ => constr:(args) end. (** [lets H: (>> E0 E1 .. EN)] will instantiate lemma [E0] on the arguments [Ei] (which may be wildcards [__]), and name [H] the resulting term. [H] may be an introduction pattern, or a sequence of introduction patterns [I1 I2 IN], or empty. Syntax [lets H: E0 E1 .. EN] is also available. If the last argument [EN] is [___] (triple-underscore), then all arguments of [H] will be instantiated. *) Ltac lets_build I Ei := let args := list_boxer_of Ei in let args := args_unfold_head_if_not_product_but_params args in (* let Ei''' := args_unfold_head_if_not_product Ei'' in*) build_app args ltac:(fun R => lets_base I R). Tactic Notation "lets" simple_intropattern(I) ":" constr(E) := lets_build I E. Tactic Notation "lets" ":" constr(E) := let H := fresh in lets H: E. Tactic Notation "lets" ":" constr(E0) constr(A1) := lets: (>> E0 A1). Tactic Notation "lets" ":" constr(E0) constr(A1) constr(A2) := lets: (>> E0 A1 A2). Tactic Notation "lets" ":" constr(E0) constr(A1) constr(A2) constr(A3) := lets: (>> E0 A1 A2 A3). Tactic Notation "lets" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := lets: (>> E0 A1 A2 A3 A4). Tactic Notation "lets" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets: (>> E0 A1 A2 A3 A4 A5). (* --todo: deprecated, do not use *) Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E) := lets [I1 I2]: E. Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) ":" constr(E) := lets [I1 [I2 I3]]: E. Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) ":" constr(E) := lets [I1 [I2 [I3 I4]]]: E. Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) ":" constr(E) := lets [I1 [I2 [I3 [I4 I5]]]]: E. Tactic Notation "lets" simple_intropattern(I) ":" constr(E0) constr(A1) := lets I: (>> E0 A1). Tactic Notation "lets" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) := lets I: (>> E0 A1 A2). Tactic Notation "lets" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) := lets I: (>> E0 A1 A2 A3). Tactic Notation "lets" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := lets I: (>> E0 A1 A2 A3 A4). Tactic Notation "lets" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets I: (>> E0 A1 A2 A3 A4 A5). Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0) constr(A1) := lets [I1 I2]: E0 A1. Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0) constr(A1) constr(A2) := lets [I1 I2]: E0 A1 A2. Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0) constr(A1) constr(A2) constr(A3) := lets [I1 I2]: E0 A1 A2 A3. Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := lets [I1 I2]: E0 A1 A2 A3 A4. Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets [I1 I2]: E0 A1 A2 A3 A4 A5. (** [forwards H: (>> E0 E1 .. EN)] is short for [forwards H: (>> E0 E1 .. EN ___)]. The arguments [Ei] can be wildcards [__] (except [E0]). [H] may be an introduction pattern, or a sequence of introduction pattern, or empty. Syntax [forwards H: E0 E1 .. EN] is also available. *) Ltac forwards_build_app_arg Ei := let args := list_boxer_of Ei in let args := (eval simpl in (args ++ ((boxer ___)::nil))) in let args := args_unfold_head_if_not_product args in args. Ltac forwards_then Ei cont := let args := forwards_build_app_arg Ei in let args := args_unfold_head_if_not_product_but_params args in build_app args cont. Tactic Notation "forwards" simple_intropattern(I) ":" constr(Ei) := let args := forwards_build_app_arg Ei in lets I: args. Tactic Notation "forwards" ":" constr(E) := let H := fresh in forwards H: E. Tactic Notation "forwards" ":" constr(E0) constr(A1) := forwards: (>> E0 A1). Tactic Notation "forwards" ":" constr(E0) constr(A1) constr(A2) := forwards: (>> E0 A1 A2). Tactic Notation "forwards" ":" constr(E0) constr(A1) constr(A2) constr(A3) := forwards: (>> E0 A1 A2 A3). Tactic Notation "forwards" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := forwards: (>> E0 A1 A2 A3 A4). Tactic Notation "forwards" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := forwards: (>> E0 A1 A2 A3 A4 A5). (* --TODO: deprecated, do not use *) Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E) := forwards [I1 I2]: E. Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) ":" constr(E) := forwards [I1 [I2 I3]]: E. Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) ":" constr(E) := forwards [I1 [I2 [I3 I4]]]: E. Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) ":" constr(E) := forwards [I1 [I2 [I3 [I4 I5]]]]: E. Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0) constr(A1) := forwards I: (>> E0 A1). Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) := forwards I: (>> E0 A1 A2). Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) := forwards I: (>> E0 A1 A2 A3). Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := forwards I: (>> E0 A1 A2 A3 A4). Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := forwards I: (>> E0 A1 A2 A3 A4 A5). (** [forwards_nounfold I: E] is like [forwards I: E] but does not unfold the head constant of [E] if there is no visible quantification or hypothesis in [E]. It is meant to be used mainly by tactics. *) Tactic Notation "forwards_nounfold" simple_intropattern(I) ":" constr(Ei) := let args := list_boxer_of Ei in let args := (eval simpl in (args ++ ((boxer ___)::nil))) in build_app args ltac:(fun R => lets_base I R). (** [forwards_nounfold_then E ltac:(fun K => ..)] is like [forwards: E] but it provides the resulting term to a continuation, under the name [K]. *) Ltac forwards_nounfold_then Ei cont := let args := list_boxer_of Ei in let args := (eval simpl in (args ++ ((boxer ___)::nil))) in build_app args cont. (** [applys (>> E0 E1 .. EN)] instantiates lemma [E0] on the arguments [Ei] (which may be wildcards [__]), and apply the resulting term to the current goal, using the tactic [applys] defined earlier on. [applys E0 E1 E2 .. EN] is also available. *) Ltac applys_build Ei := let args := list_boxer_of Ei in let args := args_unfold_head_if_not_product_but_params args in build_app args ltac:(fun R => first [ apply R | eapply R | rapply R ]). Ltac applys_base E := match type of E with | list Boxer => applys_build E | _ => first [ rapply E | applys_build E ] end; fast_rm_inside E. Tactic Notation "applys" constr(E) := applys_base E. Tactic Notation "applys" constr(E0) constr(A1) := applys (>> E0 A1). Tactic Notation "applys" constr(E0) constr(A1) constr(A2) := applys (>> E0 A1 A2). Tactic Notation "applys" constr(E0) constr(A1) constr(A2) constr(A3) := applys (>> E0 A1 A2 A3). Tactic Notation "applys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := applys (>> E0 A1 A2 A3 A4). Tactic Notation "applys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := applys (>> E0 A1 A2 A3 A4 A5). (** [fapplys (>> E0 E1 .. EN)] instantiates lemma [E0] on the arguments [Ei] and on the argument [___] meaning that all evars should be explicitly instantiated, and apply the resulting term to the current goal. [fapplys E0 E1 E2 .. EN] is also available. *) Ltac fapplys_build Ei := let args := list_boxer_of Ei in let args := (eval simpl in (args ++ ((boxer ___)::nil))) in let args := args_unfold_head_if_not_product_but_params args in build_app args ltac:(fun R => apply R). Tactic Notation "fapplys" constr(E0) := (* --TODO: use the tactic for that*) match type of E0 with | list Boxer => fapplys_build E0 | _ => fapplys_build (>> E0) end. Tactic Notation "fapplys" constr(E0) constr(A1) := fapplys (>> E0 A1). Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) := fapplys (>> E0 A1 A2). Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) constr(A3) := fapplys (>> E0 A1 A2 A3). Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := fapplys (>> E0 A1 A2 A3 A4). Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := fapplys (>> E0 A1 A2 A3 A4 A5). (** [specializes H (>> E1 E2 .. EN)] will instantiate hypothesis [H] on the arguments [Ei] (which may be wildcards [__]). If the last argument [EN] is [___] (triple-underscore), then all arguments of [H] get instantiated. *) Ltac specializes_build H Ei := let H' := fresh "TEMP" in rename H into H'; let args := list_boxer_of Ei in let args := constr:((boxer H')::args) in let args := args_unfold_head_if_not_product args in build_app args ltac:(fun R => lets H: R); clear H'. Ltac specializes_base H Ei := specializes_build H Ei; fast_rm_inside Ei. Tactic Notation "specializes" hyp(H) := specializes_base H (___). Tactic Notation "specializes" hyp(H) constr(A) := specializes_base H A. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) := specializes H (>> A1 A2). Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) := specializes H (>> A1 A2 A3). Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) := specializes H (>> A1 A2 A3 A4). Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := specializes H (>> A1 A2 A3 A4 A5). (** [specializes_vars H] is equivalent to [specializes H __ .. __] with as many double underscore as the number of dependent arguments visible from the type of [H]. Note that no unfolding is currently being performed (this behavior might change in the future). The current implementation is restricted to the case where [H] is an existing hypothesis -- TODO: generalize. *) Ltac specializes_var_base H := match type of H with | ?P -> ?Q => fail 1 | forall _:_, _ => specializes H __ end. Ltac specializes_vars_base H := repeat (specializes_var_base H). Tactic Notation "specializes_var" hyp(H) := specializes_var_base H. Tactic Notation "specializes_vars" hyp(H) := specializes_vars_base H. (* ---------------------------------------------------------------------- *) (** ** Experimental tactics for application *) (** [fapply] is a version of [apply] based on [forwards]. *) Tactic Notation "fapply" constr(E) := let H := fresh "TEMP" in forwards H: E; first [ apply H | eapply H | rapply H | hnf; apply H | hnf; eapply H | applys H ]. (* --TODO: is applys redundant with rapply ? *) (** [sapply] stands for "super apply". It tries [apply], [eapply], [applys] and [fapply], and also tries to head-normalize the goal first. *) Tactic Notation "sapply" constr(H) := first [ apply H | eapply H | rapply H | applys H | hnf; apply H | hnf; eapply H | hnf; applys H | fapply H ]. (* ---------------------------------------------------------------------- *) (** ** Adding assumptions *) (** [lets_simpl H: E] is the same as [lets H: E] excepts that it calls [simpl] on the hypothesis H. [lets_simpl: E] is also provided. *) Tactic Notation "lets_simpl" ident(H) ":" constr(E) := lets H: E; try simpl in H. Tactic Notation "lets_simpl" ":" constr(T) := let H := fresh "TEMP" in lets_simpl H: T. (** [lets_hnf H: E] is the same as [lets H: E] excepts that it calls [hnf] to set the definition in head normal form. [lets_hnf: E] is also provided. *) Tactic Notation "lets_hnf" ident(H) ":" constr(E) := lets H: E; hnf in H. Tactic Notation "lets_hnf" ":" constr(T) := let H := fresh "TEMP" in lets_hnf H: T. (** [puts X: E] is a synonymous for [pose (X := E)]. Alternative syntax is [puts: E]. *) Tactic Notation "puts" ident(X) ":" constr(E) := pose (X := E). Tactic Notation "puts" ":" constr(E) := let X := fresh "X" in pose (X := E). (* ---------------------------------------------------------------------- *) (** ** Application of tautologies *) (** [logic E], where [E] is a fact, is equivalent to [assert H:E; [tauto | eapply H; clear H]. It is useful for instance to prove a conjunction [A /\ B] by showing first [A] and then [A -> B], through the command [logic (foral A B, A -> (A -> B) -> A /\ B)] *) Ltac logic_base E cont := assert (H:E); [ cont tt | eapply H; clear H ]. Tactic Notation "logic" constr(E) := logic_base E ltac:(fun _ => tauto). (* ---------------------------------------------------------------------- *) (** ** Application modulo equalities *) (** The tactic [equates] replaces a goal of the form [P x y z] with a goal of the form [P x ?a z] and a subgoal [?a = y]. The introduction of the evar [?a] makes it possible to apply lemmas that would not apply to the original goal, for example a lemma of the form [forall n m, P n n m], because [x] and [y] might be equal but not convertible. Usage is [equates i1 ... ik], where the indices are the positions of the arguments to be replaced by evars, counting from the right-hand side. If [0] is given as argument, then the entire goal is replaced by an evar. *) Section equatesLemma. Variables (A0 A1 : Type). Variables (A2 : forall (x1 : A1), Type). Variables (A3 : forall (x1 : A1) (x2 : A2 x1), Type). Variables (A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type). Variables (A5 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3), Type). Variables (A6 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3) (x5 : A5 x4), Type). Lemma equates_0 : forall (P Q:Prop), P -> P = Q -> Q. Proof using. intros. subst. auto. Qed. Lemma equates_1 : forall (P:A0->Prop) x1 y1, P y1 -> x1 = y1 -> P x1. Proof using. intros. subst. auto. Qed. Lemma equates_2 : forall y1 (P:A0->forall(x1:A1),Prop) x1 x2, P y1 x2 -> x1 = y1 -> P x1 x2. Proof using. intros. subst. auto. Qed. Lemma equates_3 : forall y1 (P:A0->forall(x1:A1)(x2:A2 x1),Prop) x1 x2 x3, P y1 x2 x3 -> x1 = y1 -> P x1 x2 x3. Proof using. intros. subst. auto. Qed. Lemma equates_4 : forall y1 (P:A0->forall(x1:A1)(x2:A2 x1)(x3:A3 x2),Prop) x1 x2 x3 x4, P y1 x2 x3 x4 -> x1 = y1 -> P x1 x2 x3 x4. Proof using. intros. subst. auto. Qed. Lemma equates_5 : forall y1 (P:A0->forall(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3),Prop) x1 x2 x3 x4 x5, P y1 x2 x3 x4 x5 -> x1 = y1 -> P x1 x2 x3 x4 x5. Proof using. intros. subst. auto. Qed. Lemma equates_6 : forall y1 (P:A0->forall(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3)(x5:A5 x4),Prop) x1 x2 x3 x4 x5 x6, P y1 x2 x3 x4 x5 x6 -> x1 = y1 -> P x1 x2 x3 x4 x5 x6. Proof using. intros. subst. auto. Qed. End equatesLemma. Ltac equates_lemma n := match number_to_nat n with | 0 => constr:(equates_0) | 1 => constr:(equates_1) | 2 => constr:(equates_2) | 3 => constr:(equates_3) | 4 => constr:(equates_4) | 5 => constr:(equates_5) | 6 => constr:(equates_6) end. Ltac equates_one n := let L := equates_lemma n in eapply L. Ltac equates_several E cont := let all_pos := match type of E with | List.list Boxer => constr:(E) | _ => constr:((boxer E)::nil) end in let rec go pos := match pos with | nil => cont tt | (boxer ?n)::?pos' => equates_one n; [ go pos' | ] end in go all_pos. Tactic Notation "equates" constr(E) := equates_several E ltac:(fun _ => idtac). Tactic Notation "equates" constr(n1) constr(n2) := equates (>> n1 n2). Tactic Notation "equates" constr(n1) constr(n2) constr(n3) := equates (>> n1 n2 n3). Tactic Notation "equates" constr(n1) constr(n2) constr(n3) constr(n4) := equates (>> n1 n2 n3 n4). (** [applys_eq H i1 .. iK] is the same as [equates i1 .. iK] followed by [apply H] on the first subgoal. *) Tactic Notation "applys_eq" constr(H) constr(E) := equates_several E ltac:(fun _ => sapply H). Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) := applys_eq H (>> n1 n2). Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) constr(n3) := applys_eq H (>> n1 n2 n3). Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) constr(n3) constr(n4) := applys_eq H (>> n1 n2 n3 n4). (* ---------------------------------------------------------------------- *) (** ** Absurd goals *) (** [false_goal] replaces any goal by the goal [False]. Contrary to the tactic [false] (below), it does not try to do anything else *) Tactic Notation "false_goal" := exfalso. (** [false_post] is the underlying tactic used to prove goals of the form [False]. In the default implementation, it proves the goal if the context contains [False] or an hypothesis of the form [C x1 .. xN = D y1 .. yM], or if the [congruence] tactic finds a proof of [x <> x] for some [x]. *) Ltac false_post := solve [ assumption | discriminate | congruence ]. (** [false] replaces any goal by the goal [False], and calls [false_post] *) Tactic Notation "false" := false_goal; try false_post. (** [tryfalse] tries to solve a goal by contradiction, and leaves the goal unchanged if it cannot solve it. It is equivalent to [try solve \[ false \]]. *) Tactic Notation "tryfalse" := try solve [ false ]. (** [false E] tries to exploit lemma [E] to prove the goal false. [false E1 .. EN] is equivalent to [false (>> E1 .. EN)], which tries to apply [applys (>> E1 .. EN)] and if it does not work then tries [forwards H: (>> E1 .. EN)] followed with [false] *) Ltac false_then E cont := false_goal; first [ applys E | forwards_then E ltac:(fun M => pose M; jauto_set_hyps; intros; false) ]; cont tt. (* --TODO: is [cont] needed? *) Tactic Notation "false" constr(E) := false_then E ltac:(fun _ => idtac). Tactic Notation "false" constr(E) constr(E1) := false (>> E E1). Tactic Notation "false" constr(E) constr(E1) constr(E2) := false (>> E E1 E2). Tactic Notation "false" constr(E) constr(E1) constr(E2) constr(E3) := false (>> E E1 E2 E3). Tactic Notation "false" constr(E) constr(E1) constr(E2) constr(E3) constr(E4) := false (>> E E1 E2 E3 E4). (** [false_invert H] proves a goal if it absurd after calling [inversion H] and [false] *) Ltac false_invert_for H := let M := fresh "TEMP" in pose (M := H); inversion H; false. Tactic Notation "false_invert" constr(H) := try solve [ false_invert_for H | false ]. (** [false_invert] proves any goal provided there is at least one hypothesis [H] in the context (or as a universally quantified hypothesis visible at the head of the goal) that can be proved absurd by calling [inversion H]. *) Ltac false_invert_iter := match goal with H:_ |- _ => solve [ inversion H; false | clear H; false_invert_iter | fail 2 ] end. Tactic Notation "false_invert" := intros; solve [ false_invert_iter | false ]. (** [tryfalse_invert H] and [tryfalse_invert] are like the above but leave the goal unchanged if they don't solve it. *) Tactic Notation "tryfalse_invert" constr(H) := try (false_invert H). Tactic Notation "tryfalse_invert" := try false_invert. (** [false_neq_self_hyp] proves any goal if the context contains an hypothesis of the form [E <> E]. It is a restricted and optimized version of [false]. It is intended to be used by other tactics only. *) Ltac false_neq_self_hyp := match goal with H: ?x <> ?x |- _ => false_goal; apply H; reflexivity end. (* ********************************************************************** *) (** * Introduction and generalization *) (* ---------------------------------------------------------------------- *) (** ** Introduction using [=>>] *) (** [introv] is used to name only non-dependent hypothesis. - If [introv] is called on a goal of the form [forall x, H], it should introduce all the variables quantified with a [forall] at the head of the goal, but it does not introduce hypotheses that preceed an arrow constructor, like in [P -> Q]. - If [introv] is called on a goal that is not of the form [forall x, H] nor [P -> Q], the tactic unfolds definitions until the goal takes the form [forall x, H] or [P -> Q]. If unfolding definitions does not produces a goal of this form, then the tactic [introv] does nothing at all. *) (* [introv_rec] introduces all visible variables. It does not try to unfold any definition. *) Ltac introv_rec := match goal with | |- ?P -> ?Q => idtac | |- forall _, _ => intro; introv_rec | |- _ => idtac end. (* [introv_noarg] forces the goal to be a [forall] or an [->], and then calls [introv_rec] to introduces variables (possibly none, in which case [introv] is the same as [hnf]). If the goal is not a product, then it does not do anything. *) Ltac introv_noarg := match goal with | |- ?P -> ?Q => idtac | |- forall _, _ => introv_rec | |- ?G => hnf; match goal with | |- ?P -> ?Q => idtac | |- forall _, _ => introv_rec end | |- _ => idtac end. (* simpler yet perhaps less efficient imlementation *) Ltac introv_noarg_not_optimized := intro; match goal with H:_|-_ => revert H end; introv_rec. (* [introv_arg H] introduces one non-dependent hypothesis under the name [H], after introducing the variables quantified with a [forall] that preceeds this hypothesis. This tactic fails if there does not exist a hypothesis to be introduced. *) (* --TODO: __ in introv means "intros" *) Ltac introv_arg H := hnf; match goal with | |- ?P -> ?Q => intros H | |- forall _, _ => intro; introv_arg H end. (* [introv I1 .. IN] iterates [introv Ik] *) Tactic Notation "introv" := introv_noarg. Tactic Notation "introv" simple_intropattern(I1) := introv_arg I1. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) := introv I1; introv I2. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := introv I1; introv I2 I3. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) := introv I1; introv I2 I3 I4. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) := introv I1; introv I2 I3 I4 I5. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) := introv I1; introv I2 I3 I4 I5 I6. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) := introv I1; introv I2 I3 I4 I5 I6 I7. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) := introv I1; introv I2 I3 I4 I5 I6 I7 I8. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) := introv I1; introv I2 I3 I4 I5 I6 I7 I8 I9. Tactic Notation "introv" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) simple_intropattern(I10) := introv I1; introv I2 I3 I4 I5 I6 I7 I8 I9 I10. (** [intros_all] repeats [intro] as long as possible. Contrary to [intros], it unfolds any definition on the way. Remark that it also unfolds the definition of negation, so applying [intros_all] to a goal of the form [forall x, P x -> ~Q] will introduce [x] and [P x] and [Q], and will leave [False] in the goal. *) Tactic Notation "intros_all" := repeat intro. (** [intros_hnf] introduces an hypothesis and sets in head normal form *) Tactic Notation "intro_hnf" := intro; match goal with H: _ |- _ => hnf in H end. (* ---------------------------------------------------------------------- *) (** ** Introduction using [=>] and [=>>] *) (* [=> I1 .. IN] is the same as [intros I1 .. IN] *) Ltac ltac_intros_post := idtac. Tactic Notation "=>" := intros. Tactic Notation "=>" simple_intropattern(I1) := intros I1. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) := intros I1 I2. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := intros I1 I2 I3. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) := intros I1 I2 I3 I4. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) := intros I1 I2 I3 I4 I5. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) := intros I1 I2 I3 I4 I5 I6. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) := intros I1 I2 I3 I4 I5 I6 I7. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) := intros I1 I2 I3 I4 I5 I6 I7 I8. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) := intros I1 I2 I3 I4 I5 I6 I7 I8 I9. Tactic Notation "=>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) simple_intropattern(I10) := intros I1 I2 I3 I4 I5 I6 I7 I8 I9 I10. (* [=>>] first introduces all non-dependent variables, then behaves as [intros]. It unfolds the head of the goal using [hnf] if there are not head visible quantifiers. Remark: instances of [Inhab] are treated as non-dependent and are introduced automatically. *) (* NOTE: this tactic is later redefined for supporting Inhab *) Ltac intro_nondeps_aux_special_intro G := fail. Ltac intro_nondeps_aux is_already_hnf := match goal with | |- (?P -> ?Q) => idtac | |- ?G -> _ => intro_nondeps_aux_special_intro G; intro; intro_nondeps_aux true | |- (forall _,_) => intros ?; intro_nondeps_aux true | |- _ => match is_already_hnf with | true => idtac | false => hnf; intro_nondeps_aux true end end. Ltac intro_nondeps tt := intro_nondeps_aux false. Tactic Notation "=>>" := intro_nondeps tt. Tactic Notation "=>>" simple_intropattern(I1) := =>>; intros I1. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) := =>>; intros I1 I2. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := =>>; intros I1 I2 I3. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) := =>>; intros I1 I2 I3 I4. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) := =>>; intros I1 I2 I3 I4 I5. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) := =>>; intros I1 I2 I3 I4 I5 I6. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) := =>>; intros I1 I2 I3 I4 I5 I6 I7. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) := =>>; intros I1 I2 I3 I4 I5 I6 I7 I8. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) := =>>; intros I1 I2 I3 I4 I5 I6 I7 I8 I9. Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) simple_intropattern(I10) := =>>; intros I1 I2 I3 I4 I5 I6 I7 I8 I9 I10. (* ---------------------------------------------------------------------- *) (** ** Generalization *) (** [gen X1 .. XN] is a shorthand for calling [generalize dependent] successively on variables [XN]...[X1]. Note that the variables are generalized in reverse order, following the convention of the [generalize] tactic: it means that [X1] will be the first quantified variable in the resulting goal. *) Tactic Notation "gen" ident(X1) := generalize dependent X1. Tactic Notation "gen" ident(X1) ident(X2) := gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) := gen X3; gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) := gen X4; gen X3; gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) := gen X5; gen X4; gen X3; gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) := gen X6; gen X5; gen X4; gen X3; gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) := gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) ident(X8) := gen X8; gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) ident(X8) ident(X9) := gen X9; gen X8; gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1. Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) ident(X8) ident(X9) ident(X10) := gen X10; gen X9; gen X8; gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1. (** [generalizes X] is a shorthand for calling [generalize X; clear X]. It is weaker than tactic [gen X] since it does not support dependencies. It is mainly intended for writing tactics. *) Tactic Notation "generalizes" hyp(X) := generalize X; clear X. Tactic Notation "generalizes" hyp(X1) hyp(X2) := generalizes X1; generalizes X2. Tactic Notation "generalizes" hyp(X1) hyp(X2) hyp(X3) := generalizes X1 X2; generalizes X3. Tactic Notation "generalizes" hyp(X1) hyp(X2) hyp(X3) hyp(X4) := generalizes X1 X2 X3; generalizes X4. (* ---------------------------------------------------------------------- *) (** ** Naming *) (** [sets X: E] is the same as [set (X := E) in *], that is, it replaces all occurences of [E] by a fresh meta-variable [X] whose definition is [E]. *) Tactic Notation "sets" ident(X) ":" constr(E) := set (X := E) in *. (** [def_to_eq E X H] applies when [X := E] is a local definition. It adds an assumption [H: X = E] and then clears the definition of [X]. [def_to_eq_sym] is similar except that it generates the equality [H: E = X]. *) Ltac def_to_eq X HX E := assert (HX : X = E) by reflexivity; clearbody X. Ltac def_to_eq_sym X HX E := assert (HX : E = X) by reflexivity; clearbody X. (** [set_eq X H: E] generates the equality [H: X = E], for a fresh name [X], and replaces [E] by [X] in the current goal. Syntaxes [set_eq X: E] and [set_eq: E] are also available. Similarly, [set_eq <- X H: E] generates the equality [H: E = X]. [sets_eq X HX: E] does the same but replaces [E] by [X] everywhere in the goal. [sets_eq X HX: E in H] replaces in [H]. [set_eq X HX: E in |-] performs no substitution at all. *) Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) := set (X := E); def_to_eq X HX E. Tactic Notation "set_eq" ident(X) ":" constr(E) := let HX := fresh "EQ" X in set_eq X HX: E. Tactic Notation "set_eq" ":" constr(E) := let X := fresh "X" in set_eq X: E. Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) := set (X := E); def_to_eq_sym X HX E. Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) := let HX := fresh "EQ" X in set_eq <- X HX: E. Tactic Notation "set_eq" "<-" ":" constr(E) := let X := fresh "X" in set_eq <- X: E. Tactic Notation "sets_eq" ident(X) ident(HX) ":" constr(E) := set (X := E) in *; def_to_eq X HX E. Tactic Notation "sets_eq" ident(X) ":" constr(E) := let HX := fresh "EQ" X in sets_eq X HX: E. Tactic Notation "sets_eq" ":" constr(E) := let X := fresh "X" in sets_eq X: E. Tactic Notation "sets_eq" "<-" ident(X) ident(HX) ":" constr(E) := set (X := E) in *; def_to_eq_sym X HX E. Tactic Notation "sets_eq" "<-" ident(X) ":" constr(E) := let HX := fresh "EQ" X in sets_eq <- X HX: E. Tactic Notation "sets_eq" "<-" ":" constr(E) := let X := fresh "X" in sets_eq <- X: E. Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) "in" hyp(H) := set (X := E) in H; def_to_eq X HX E. Tactic Notation "set_eq" ident(X) ":" constr(E) "in" hyp(H) := let HX := fresh "EQ" X in set_eq X HX: E in H. Tactic Notation "set_eq" ":" constr(E) "in" hyp(H) := let X := fresh "X" in set_eq X: E in H. Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) "in" hyp(H) := set (X := E) in H; def_to_eq_sym X HX E. Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) "in" hyp(H) := let HX := fresh "EQ" X in set_eq <- X HX: E in H. Tactic Notation "set_eq" "<-" ":" constr(E) "in" hyp(H) := let X := fresh "X" in set_eq <- X: E in H. Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) "in" "|-" := set (X := E) in |-; def_to_eq X HX E. Tactic Notation "set_eq" ident(X) ":" constr(E) "in" "|-" := let HX := fresh "EQ" X in set_eq X HX: E in |-. Tactic Notation "set_eq" ":" constr(E) "in" "|-" := let X := fresh "X" in set_eq X: E in |-. Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) "in" "|-" := set (X := E) in |-; def_to_eq_sym X HX E. Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) "in" "|-" := let HX := fresh "EQ" X in set_eq <- X HX: E in |-. Tactic Notation "set_eq" "<-" ":" constr(E) "in" "|-" := let X := fresh "X" in set_eq <- X: E in |-. (** [gen_eq X: E] is a tactic whose purpose is to introduce equalities so as to work around the limitation of the [induction] tactic which typically loses information. [gen_eq E as X] replaces all occurences of term [E] with a fresh variable [X] and the equality [X = E] as extra hypothesis to the current conclusion. In other words a conclusion [C] will be turned into [(X = E) -> C]. [gen_eq: E] and [gen_eq: E as X] are also accepted. *) Tactic Notation "gen_eq" ident(X) ":" constr(E) := let EQ := fresh "EQ" X in sets_eq X EQ: E; revert EQ. Tactic Notation "gen_eq" ":" constr(E) := let X := fresh "X" in gen_eq X: E. Tactic Notation "gen_eq" ":" constr(E) "as" ident(X) := gen_eq X: E. Tactic Notation "gen_eq" ident(X1) ":" constr(E1) "," ident(X2) ":" constr(E2) := gen_eq X2: E2; gen_eq X1: E1. Tactic Notation "gen_eq" ident(X1) ":" constr(E1) "," ident(X2) ":" constr(E2) "," ident(X3) ":" constr(E3) := gen_eq X3: E3; gen_eq X2: E2; gen_eq X1: E1. (** [sets_let X] finds the first let-expression in the goal and names its body [X]. [sets_eq_let X] is similar, except that it generates an explicit equality. Tactics [sets_let X in H] and [sets_eq_let X in H] allow specifying a particular hypothesis (by default, the first one that contains a [let] is considered). Known limitation: it does not seem possible to support naming of multiple let-in constructs inside a term, from ltac. *) Ltac sets_let_base tac := match goal with | |- context[let _ := ?E in _] => tac E; cbv zeta | H: context[let _ := ?E in _] |- _ => tac E; cbv zeta in H end. Ltac sets_let_in_base H tac := match type of H with context[let _ := ?E in _] => tac E; cbv zeta in H end. Tactic Notation "sets_let" ident(X) := sets_let_base ltac:(fun E => sets X: E). Tactic Notation "sets_let" ident(X) "in" hyp(H) := sets_let_in_base H ltac:(fun E => sets X: E). Tactic Notation "sets_eq_let" ident(X) := sets_let_base ltac:(fun E => sets_eq X: E). Tactic Notation "sets_eq_let" ident(X) "in" hyp(H) := sets_let_in_base H ltac:(fun E => sets_eq X: E). (* ********************************************************************** *) (** * Rewriting *) (** [rewrites E] is similar to [rewrite] except that it supports the [rm] directives to clear hypotheses on the fly, and that it supports a list of arguments in the form [rewrites (>> E1 E2 E3)] to indicate that [forwards] should be invoked first before [rewrites] is called. *) Ltac rewrites_base E cont := match type of E with | List.list Boxer => forwards_then E cont | _ => cont E; fast_rm_inside E end. Tactic Notation "rewrites" constr(E) := rewrites_base E ltac:(fun M => rewrite M ). Tactic Notation "rewrites" constr(E) "in" hyp(H) := rewrites_base E ltac:(fun M => rewrite M in H). Tactic Notation "rewrites" constr(E) "in" "*" := rewrites_base E ltac:(fun M => rewrite M in *). Tactic Notation "rewrites" "<-" constr(E) := rewrites_base E ltac:(fun M => rewrite <- M ). Tactic Notation "rewrites" "<-" constr(E) "in" hyp(H) := rewrites_base E ltac:(fun M => rewrite <- M in H). Tactic Notation "rewrites" "<-" constr(E) "in" "*" := rewrites_base E ltac:(fun M => rewrite <- M in *). (* --TODO: extend tactics below to use [rewrites] *) (** [rewrite_all E] iterates version of [rewrite E] as long as possible. Warning: this tactic can easily get into an infinite loop. Syntax for rewriting from right to left and/or into an hypothese is similar to the one of [rewrite]. *) Tactic Notation "rewrite_all" constr(E) := repeat rewrite E. Tactic Notation "rewrite_all" "<-" constr(E) := repeat rewrite <- E. Tactic Notation "rewrite_all" constr(E) "in" ident(H) := repeat rewrite E in H. Tactic Notation "rewrite_all" "<-" constr(E) "in" ident(H) := repeat rewrite <- E in H. Tactic Notation "rewrite_all" constr(E) "in" "*" := repeat rewrite E in *. Tactic Notation "rewrite_all" "<-" constr(E) "in" "*" := repeat rewrite <- E in *. (** [asserts_rewrite E] asserts that an equality [E] holds (generating a corresponding subgoal) and rewrite it straight away in the current goal. It avoids giving a name to the equality and later clearing it. Syntax for rewriting from right to left and/or into an hypothese is similar to the one of [rewrite]. Note: the tactic [replaces] plays a similar role. *) Ltac asserts_rewrite_tactic E action := let EQ := fresh "TEMP" in (assert (EQ : E); [ idtac | action EQ; clear EQ ]). Tactic Notation "asserts_rewrite" constr(E) := asserts_rewrite_tactic E ltac:(fun EQ => rewrite EQ). Tactic Notation "asserts_rewrite" "<-" constr(E) := asserts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ). Tactic Notation "asserts_rewrite" constr(E) "in" hyp(H) := asserts_rewrite_tactic E ltac:(fun EQ => rewrite EQ in H). Tactic Notation "asserts_rewrite" "<-" constr(E) "in" hyp(H) := asserts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ in H). Tactic Notation "asserts_rewrite" constr(E) "in" "*" := asserts_rewrite_tactic E ltac:(fun EQ => rewrite EQ in *). Tactic Notation "asserts_rewrite" "<-" constr(E) "in" "*" := asserts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ in *). (** [cuts_rewrite E] is the same as [asserts_rewrite E] except that subgoals are permuted. *) Ltac cuts_rewrite_tactic E action := let EQ := fresh "TEMP" in (cuts EQ: E; [ action EQ; clear EQ | idtac ]). Tactic Notation "cuts_rewrite" constr(E) := cuts_rewrite_tactic E ltac:(fun EQ => rewrite EQ). Tactic Notation "cuts_rewrite" "<-" constr(E) := cuts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ). Tactic Notation "cuts_rewrite" constr(E) "in" hyp(H) := cuts_rewrite_tactic E ltac:(fun EQ => rewrite EQ in H). Tactic Notation "cuts_rewrite" "<-" constr(E) "in" hyp(H) := cuts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ in H). (** [rewrite_except H EQ] rewrites equality [EQ] everywhere but in hypothesis [H]. Mainly useful for other tactics. *) Ltac rewrite_except H EQ := let K := fresh "TEMP" in let T := type of H in set (K := T) in H; rewrite EQ in *; unfold K in H; clear K. (** [rewrites E at K] applies when [E] is of the form [T1 = T2] rewrites the equality [E] at the [K]-th occurence of [T1] in the current goal. Syntaxes [rewrites <- E at K] and [rewrites E at K in H] are also available. *) Tactic Notation "rewrites" constr(E) "at" constr(K) := match type of E with ?T1 = ?T2 => ltac_action_at K of T1 do (rewrites E) end. Tactic Notation "rewrites" "<-" constr(E) "at" constr(K) := match type of E with ?T1 = ?T2 => ltac_action_at K of T2 do (rewrites <- E) end. Tactic Notation "rewrites" constr(E) "at" constr(K) "in" hyp(H) := match type of E with ?T1 = ?T2 => ltac_action_at K of T1 in H do (rewrites E in H) end. Tactic Notation "rewrites" "<-" constr(E) "at" constr(K) "in" hyp(H) := match type of E with ?T1 = ?T2 => ltac_action_at K of T2 in H do (rewrites <- E in H) end. (* ---------------------------------------------------------------------- *) (** ** Replace *) (** [replaces E with F] is the same as [replace E with F] except that the equality [E = F] is generated as first subgoal. Syntax [replaces E with F in H] is also available. Note that contrary to [replace], [replaces] does not try to solve the equality by [assumption]. Note: [replaces E with F] is similar to [asserts_rewrite (E = F)]. *) Tactic Notation "replaces" constr(E) "with" constr(F) := let T := fresh "TEMP" in assert (T: E = F); [ | replace E with F; clear T ]. Tactic Notation "replaces" constr(E) "with" constr(F) "in" hyp(H) := let T := fresh "TEMP" in assert (T: E = F); [ | replace E with F in H; clear T ]. (** [replaces E at K with F] replaces the [K]-th occurence of [E] with [F] in the current goal. Syntax [replaces E at K with F in H] is also available. *) Tactic Notation "replaces" constr(E) "at" constr(K) "with" constr(F) := let T := fresh "TEMP" in assert (T: E = F); [ | rewrites T at K; clear T ]. Tactic Notation "replaces" constr(E) "at" constr(K) "with" constr(F) "in" hyp(H) := let T := fresh "TEMP" in assert (T: E = F); [ | rewrites T at K in H; clear T ]. (* ---------------------------------------------------------------------- *) (** ** Change *) (** [changes] is like [change] except that it does not silently fail to perform its task. (Note that, [changes] is implemented using [rewrite], meaning that it might perform additional beta-reductions compared with the original [change] tactic. *) (* --TODO: support "changes (E1 = E2)" *) Tactic Notation "changes" constr(E1) "with" constr(E2) "in" hyp(H) := asserts_rewrite (E1 = E2) in H; [ reflexivity | ]. Tactic Notation "changes" constr(E1) "with" constr(E2) := asserts_rewrite (E1 = E2); [ reflexivity | ]. Tactic Notation "changes" constr(E1) "with" constr(E2) "in" "*" := asserts_rewrite (E1 = E2) in *; [ reflexivity | ]. (* ---------------------------------------------------------------------- *) (** ** Renaming *) (** [renames X1 to Y1, ..., XN to YN] is a shorthand for a sequence of renaming operations [rename Xi into Yi]. *) Tactic Notation "renames" ident(X1) "to" ident(Y1) := rename X1 into Y1. Tactic Notation "renames" ident(X1) "to" ident(Y1) "," ident(X2) "to" ident(Y2) := renames X1 to Y1; renames X2 to Y2. Tactic Notation "renames" ident(X1) "to" ident(Y1) "," ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) := renames X1 to Y1; renames X2 to Y2, X3 to Y3. Tactic Notation "renames" ident(X1) "to" ident(Y1) "," ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) "," ident(X4) "to" ident(Y4) := renames X1 to Y1; renames X2 to Y2, X3 to Y3, X4 to Y4. Tactic Notation "renames" ident(X1) "to" ident(Y1) "," ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) "," ident(X4) "to" ident(Y4) "," ident(X5) "to" ident(Y5) := renames X1 to Y1; renames X2 to Y2, X3 to Y3, X4 to Y4, X5 to Y5. Tactic Notation "renames" ident(X1) "to" ident(Y1) "," ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) "," ident(X4) "to" ident(Y4) "," ident(X5) "to" ident(Y5) "," ident(X6) "to" ident(Y6) := renames X1 to Y1; renames X2 to Y2, X3 to Y3, X4 to Y4, X5 to Y5, X6 to Y6. (* ---------------------------------------------------------------------- *) (** ** Unfolding *) (** [unfolds] unfolds the head definition in the goal, i.e. if the goal has form [P x1 ... xN] then it calls [unfold P]. If the goal is an equality, it tries to unfold the head constant on the left-hand side, and otherwise tries on the right-hand side. If the goal is a product, it calls [intros] first. -- warning: this tactic is overriden in LibReflect. *) Ltac apply_to_head_of E cont := let go E := let P := get_head E in cont P in match E with | forall _,_ => intros; apply_to_head_of E cont | ?A = ?B => first [ go A | go B ] | ?A => go A end. Ltac unfolds_base := match goal with |- ?G => apply_to_head_of G ltac:(fun P => unfold P) end. Tactic Notation "unfolds" := unfolds_base. (** [unfolds in H] unfolds the head definition of hypothesis [H], i.e. if [H] has type [P x1 ... xN] then it calls [unfold P in H]. *) Ltac unfolds_in_base H := match type of H with ?G => apply_to_head_of G ltac:(fun P => unfold P in H) end. Tactic Notation "unfolds" "in" hyp(H) := unfolds_in_base H. (** [unfolds in H1,H2,..,HN] allows unfolding the head constant in several hypotheses at once. *) Tactic Notation "unfolds" "in" hyp(H1) hyp(H2) := unfolds in H1; unfolds in H2. Tactic Notation "unfolds" "in" hyp(H1) hyp(H2) hyp(H3) := unfolds in H1; unfolds in H2 H3. Tactic Notation "unfolds" "in" hyp(H1) hyp(H2) hyp(H3) hyp(H4) := unfolds in H1; unfolds in H2 H3 H4. Tactic Notation "unfolds" "in" hyp(H1) hyp(H2) hyp(H3) hyp(H4) hyp(H5) := unfolds in H1; unfolds in H2 H3 H4 H5. (** [unfolds P1,..,PN] is a shortcut for [unfold P1,..,PN in *]. *) Tactic Notation "unfolds" constr(F1) := unfold F1 in *. Tactic Notation "unfolds" constr(F1) "," constr(F2) := unfold F1,F2 in *. Tactic Notation "unfolds" constr(F1) "," constr(F2) "," constr(F3) := unfold F1,F2,F3 in *. Tactic Notation "unfolds" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) := unfold F1,F2,F3,F4 in *. Tactic Notation "unfolds" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) "," constr(F5) := unfold F1,F2,F3,F4,F5 in *. Tactic Notation "unfolds" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) "," constr(F5) "," constr(F6) := unfold F1,F2,F3,F4,F5,F6 in *. Tactic Notation "unfolds" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) "," constr(F5) "," constr(F6) "," constr(F7) := unfold F1,F2,F3,F4,F5,F6,F7 in *. Tactic Notation "unfolds" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) "," constr(F5) "," constr(F6) "," constr(F7) "," constr(F8) := unfold F1,F2,F3,F4,F5,F6,F7,F8 in *. (** [folds P1,..,PN] is a shortcut for [fold P1 in *; ..; fold PN in *]. *) Tactic Notation "folds" constr(H) := fold H in *. Tactic Notation "folds" constr(H1) "," constr(H2) := folds H1; folds H2. Tactic Notation "folds" constr(H1) "," constr(H2) "," constr(H3) := folds H1; folds H2; folds H3. Tactic Notation "folds" constr(H1) "," constr(H2) "," constr(H3) "," constr(H4) := folds H1; folds H2; folds H3; folds H4. Tactic Notation "folds" constr(H1) "," constr(H2) "," constr(H3) "," constr(H4) "," constr(H5) := folds H1; folds H2; folds H3; folds H4; folds H5. (* ---------------------------------------------------------------------- *) (** ** Simplification *) (** [simpls] is a shortcut for [simpl in *]. *) Tactic Notation "simpls" := simpl in *. (** [simpls P1,..,PN] is a shortcut for [simpl P1 in *; ..; simpl PN in *]. *) Tactic Notation "simpls" constr(F1) := simpl F1 in *. Tactic Notation "simpls" constr(F1) "," constr(F2) := simpls F1; simpls F2. Tactic Notation "simpls" constr(F1) "," constr(F2) "," constr(F3) := simpls F1; simpls F2; simpls F3. Tactic Notation "simpls" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) := simpls F1; simpls F2; simpls F3; simpls F4. (** [unsimpl E] replaces all occurence of [X] by [E], where [X] is the result which the tactic [simpl] would give when applied to [E]. It is useful to undo what [simpl] has simplified too far. *) Tactic Notation "unsimpl" constr(E) := let F := (eval simpl in E) in change F with E. (** [unsimpl E in H] is similar to [unsimpl E] but it applies inside a particular hypothesis [H]. *) Tactic Notation "unsimpl" constr(E) "in" hyp(H) := let F := (eval simpl in E) in change F with E in H. (** [unsimpl E in *] applies [unsimpl E] everywhere possible. [unsimpls E] is a synonymous. *) Tactic Notation "unsimpl" constr(E) "in" "*" := let F := (eval simpl in E) in change F with E in *. Tactic Notation "unsimpls" constr(E) := unsimpl E in *. (** [nosimpl t] protects the Coq term[t] against some forms of simplification. See Gonthier's work for details on this trick. *) Notation "'nosimpl' t" := (match tt with tt => t end) (at level 10). (* ---------------------------------------------------------------------- *) (** ** Evaluation *) Tactic Notation "hnfs" := hnf in *. (* ---------------------------------------------------------------------- *) (** ** Substitution *) (** [substs] does the same as [subst], except that it does not fail when there are circular equalities in the context. *) Tactic Notation "substs" := repeat (match goal with H: ?x = ?y |- _ => first [ subst x | subst y ] end). (** Implementation of [substs below], which allows to call [subst] on all the hypotheses that lie beyond a given position in the proof context. *) Ltac substs_below limit := match goal with H: ?T |- _ => match T with | limit => idtac | ?x = ?y => first [ subst x; substs_below limit | subst y; substs_below limit | generalizes H; substs_below limit; intro ] end end. (** [substs below body E] applies [subst] on all equalities that appear in the context below the first hypothesis whose body is [E]. If there is no such hypothesis in the context, it is equivalent to [subst]. For instance, if [H] is an hypothesis, then [substs below H] will substitute equalities below hypothesis [H]. *) Tactic Notation "substs" "below" "body" constr(M) := substs_below M. (** [substs below H] applies [subst] on all equalities that appear in the context below the hypothesis named [H]. Note that the current implementation is technically incorrect since it will confuse different hypotheses with the same body. *) Tactic Notation "substs" "below" hyp(H) := match type of H with ?M => substs below body M end. (** [subst_hyp H] substitutes the equality contained in the first hypothesis from the context. *) Ltac intro_subst_hyp := fail. (* definition further on *) (** [subst_hyp H] substitutes the equality contained in [H]. *) Ltac subst_hyp_base H := match type of H with | (_,_,_,_,_) = (_,_,_,_,_) => injection H; clear H; do 4 intro_subst_hyp | (_,_,_,_) = (_,_,_,_) => injection H; clear H; do 4 intro_subst_hyp | (_,_,_) = (_,_,_) => injection H; clear H; do 3 intro_subst_hyp | (_,_) = (_,_) => injection H; clear H; do 2 intro_subst_hyp | ?x = ?x => clear H | ?x = ?y => first [ subst x | subst y ] end. Tactic Notation "subst_hyp" hyp(H) := subst_hyp_base H. Ltac intro_subst_hyp ::= let H := fresh "TEMP" in intros H; subst_hyp H. (** [intro_subst] is a shorthand for [intro H; subst_hyp H]: it introduces and substitutes the equality at the head of the current goal. *) Tactic Notation "intro_subst" := let H := fresh "TEMP" in intros H; subst_hyp H. (** [subst_local] substitutes all local definition from the context *) Ltac subst_local := repeat match goal with H:=_ |- _ => subst H end. (** [subst_eq E] takes an equality [x = t] and replace [x] with [t] everywhere in the goal *) Ltac subst_eq_base E := let H := fresh "TEMP" in lets H: E; subst_hyp H. Tactic Notation "subst_eq" constr(E) := subst_eq_base E. (* ---------------------------------------------------------------------- *) (** ** Tactics to work with proof irrelevance *) Require Import Coq.Logic.ProofIrrelevance. (** [pi_rewrite E] replaces [E] of type [Prop] with a fresh unification variable, and is thus a practical way to exploit proof irrelevance, without writing explicitly [rewrite (proof_irrelevance E E')]. Particularly useful when [E'] is a big expression. *) Ltac pi_rewrite_base E rewrite_tac := let E' := fresh "TEMP" in let T := type of E in evar (E':T); rewrite_tac (@proof_irrelevance _ E E'); subst E'. Tactic Notation "pi_rewrite" constr(E) := pi_rewrite_base E ltac:(fun X => rewrite X). Tactic Notation "pi_rewrite" constr(E) "in" hyp(H) := pi_rewrite_base E ltac:(fun X => rewrite X in H). (* ---------------------------------------------------------------------- *) (** ** Proving equalities *) (** Note: current implementation only supports up to arity 5 *) (** [fequal] is a variation on [f_equal] which has a better behaviour on equalities between n-ary tuples. *) Ltac fequal_base := let go := f_equal; [ fequal_base | ] in match goal with | |- (_,_,_) = (_,_,_) => go | |- (_,_,_,_) = (_,_,_,_) => go | |- (_,_,_,_,_) = (_,_,_,_,_) => go | |- (_,_,_,_,_,_) = (_,_,_,_,_,_) => go | |- _ => f_equal end. Tactic Notation "fequal" := fequal_base. (** [fequals] is the same as [fequal] except that it tries and solve all trivial subgoals, using [reflexivity] and [congruence] (as well as the proof-irrelevance principle). [fequals] applies to goals of the form [f x1 .. xN = f y1 .. yN] and produces some subgoals of the form [xi = yi]). *) Ltac fequal_post := first [ reflexivity | congruence | apply proof_irrelevance | idtac ]. Tactic Notation "fequals" := fequal; fequal_post. (** [fequals_rec] calls [fequals] recursively. It is equivalent to [repeat (progress fequals)]. *) Tactic Notation "fequals_rec" := repeat (progress fequals). (* ********************************************************************** *) (** * Inversion *) (* ---------------------------------------------------------------------- *) (** ** Basic inversion *) (** [invert keep H] is same to [inversion H] except that it puts all the facts obtained in the goal. The keyword [keep] means that the hypothesis [H] should not be removed. *) Tactic Notation "invert" "keep" hyp(H) := pose ltac_mark; inversion H; gen_until_mark. (** [invert keep H as X1 .. XN] is the same as [inversion H as ...] except that only hypotheses which are not variable need to be named explicitely, in a similar fashion as [introv] is used to name only hypotheses. *) Tactic Notation "invert" "keep" hyp(H) "as" simple_intropattern(I1) := invert keep H; introv I1. Tactic Notation "invert" "keep" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) := invert keep H; introv I1 I2. Tactic Notation "invert" "keep" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := invert keep H; introv I1 I2 I3. (** [invert H] is same to [inversion H] except that it puts all the facts obtained in the goal and clears hypothesis [H]. In other words, it is equivalent to [invert keep H; clear H]. *) Tactic Notation "invert" hyp(H) := invert keep H; clear H. (** [invert H as X1 .. XN] is the same as [invert keep H as X1 .. XN] but it also clears hypothesis [H]. *) Tactic Notation "invert_tactic" hyp(H) tactic(tac) := let H' := fresh "TEMP" in rename H into H'; tac H'; clear H'. Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1) := invert_tactic H (fun H => invert keep H as I1). Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) := invert_tactic H (fun H => invert keep H as I1 I2). Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := invert_tactic H (fun H => invert keep H as I1 I2 I3). (* ---------------------------------------------------------------------- *) (** ** Inversion with substitution *) (** Our inversion tactics is able to get rid of dependent equalities generated by [inversion], using proof irrelevance. *) (* --we do not import Eqdep because it imports nasty hints automatically From TLC Require Import Eqdep. *) Axiom inj_pair2 : (* is in fact derivable from the axioms in LibAxiom.v *) forall (U : Type) (P : U -> Type) (p : U) (x y : P p), existT P p x = existT P p y -> x = y. (* Proof using. apply Eqdep.EqdepTheory.inj_pair2. Qed.*) Ltac inverts_tactic H i1 i2 i3 i4 i5 i6 := let rec go i1 i2 i3 i4 i5 i6 := match goal with | |- (ltac_Mark -> _) => intros _ | |- (?x = ?y -> _) => let H := fresh "TEMP" in intro H; first [ subst x | subst y ]; go i1 i2 i3 i4 i5 i6 | |- (existT ?P ?p ?x = existT ?P ?p ?y -> _) => let H := fresh "TEMP" in intro H; generalize (@inj_pair2 _ P p x y H); clear H; go i1 i2 i3 i4 i5 i6 | |- (?P -> ?Q) => i1; go i2 i3 i4 i5 i6 ltac:(intro) | |- (forall _, _) => intro; go i1 i2 i3 i4 i5 i6 end in generalize ltac_mark; invert keep H; go i1 i2 i3 i4 i5 i6; unfold eq' in *. (** [inverts keep H] is same to [invert keep H] except that it applies [subst] to all the equalities generated by the inversion. *) Tactic Notation "inverts" "keep" hyp(H) := inverts_tactic H ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro). (** [inverts keep H as X1 .. XN] is the same as [invert keep H as X1 .. XN] except that it applies [subst] to all the equalities generated by the inversion *) Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1) := inverts_tactic H ltac:(intros I1) ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro). Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) := inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro). Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3) ltac:(intro) ltac:(intro) ltac:(intro). Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) := inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3) ltac:(intros I4) ltac:(intro) ltac:(intro). Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) := inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3) ltac:(intros I4) ltac:(intros I5) ltac:(intro). Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) := inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3) ltac:(intros I4) ltac:(intros I5) ltac:(intros I6). (** [inverts H] is same to [inverts keep H] except that it clears hypothesis [H]. *) Tactic Notation "inverts" hyp(H) := inverts keep H; try clear H. (** [inverts H as X1 .. XN] is the same as [inverts keep H as X1 .. XN] but it also clears the hypothesis [H]. *) Tactic Notation "inverts_tactic" hyp(H) tactic(tac) := let H' := fresh "TEMP" in rename H into H'; tac H'; clear H'. Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) := invert_tactic H (fun H => inverts keep H as I1). Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) := invert_tactic H (fun H => inverts keep H as I1 I2). Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := invert_tactic H (fun H => inverts keep H as I1 I2 I3). Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) := invert_tactic H (fun H => inverts keep H as I1 I2 I3 I4). Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) := invert_tactic H (fun H => inverts keep H as I1 I2 I3 I4 I5). Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) := invert_tactic H (fun H => inverts keep H as I1 I2 I3 I4 I5 I6). (** [inverts H as] performs an inversion on hypothesis [H], substitutes generated equalities, and put in the goal the other freshly-created hypotheses, for the user to name explicitly. [inverts keep H as] is the same except that it does not clear [H]. --TODO: reimplement [inverts] above using this one *) Ltac inverts_as_tactic H := let rec go tt := match goal with | |- (ltac_Mark -> _) => intros _ | |- (?x = ?y -> _) => let H := fresh "TEMP" in intro H; first [ subst x | subst y ]; go tt | |- (existT ?P ?p ?x = existT ?P ?p ?y -> _) => let H := fresh "TEMP" in intro H; generalize (@inj_pair2 _ P p x y H); clear H; go tt | |- (forall _, _) => intro; let H := get_last_hyp tt in mark_to_generalize H; go tt end in pose ltac_mark; inversion H; generalize ltac_mark; gen_until_mark; go tt; gen_to_generalize; unfolds ltac_to_generalize; unfold eq' in *. Tactic Notation "inverts" "keep" hyp(H) "as" := inverts_as_tactic H. Tactic Notation "inverts" hyp(H) "as" := inverts_as_tactic H; clear H. Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) := inverts H as; introv I1 I2 I3 I4 I5 I6 I7. Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) := inverts H as; introv I1 I2 I3 I4 I5 I6 I7 I8. (** [lets_inverts E as I1 .. IN] is intuitively equivalent to [inverts E], with the difference that it applies to any expression and not just to the name of an hypothesis. *) Ltac lets_inverts_base E cont := let H := fresh "TEMP" in lets H: E; try cont H. Tactic Notation "lets_inverts" constr(E) := lets_inverts_base E ltac:(fun H => inverts H). Tactic Notation "lets_inverts" constr(E) "as" simple_intropattern(I1) := lets_inverts_base E ltac:(fun H => inverts H as I1). Tactic Notation "lets_inverts" constr(E) "as" simple_intropattern(I1) simple_intropattern(I2) := lets_inverts_base E ltac:(fun H => inverts H as I1 I2). Tactic Notation "lets_inverts" constr(E) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := lets_inverts_base E ltac:(fun H => inverts H as I1 I2 I3). Tactic Notation "lets_inverts" constr(E) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) := lets_inverts_base E ltac:(fun H => inverts H as I1 I2 I3 I4). (* ---------------------------------------------------------------------- *) (** ** Injection with substitution *) (** Underlying implementation of [injects] *) Ltac injects_tactic H := let rec go _ := match goal with | |- (ltac_Mark -> _) => intros _ | |- (?x = ?y -> _) => let H := fresh "TEMP" in intro H; first [ subst x | subst y | idtac ]; go tt end in generalize ltac_mark; injection H; go tt. (** [injects keep H] takes an hypothesis [H] of the form [C a1 .. aN = C b1 .. bN] and substitute all equalities [ai = bi] that have been generated. *) Tactic Notation "injects" "keep" hyp(H) := injects_tactic H. (** [injects H] is similar to [injects keep H] but clears the hypothesis [H]. *) Tactic Notation "injects" hyp(H) := injects_tactic H; clear H. (** [inject H as X1 .. XN] is the same as [injection] followed by [intros X1 .. XN] *) Tactic Notation "inject" hyp(H) := injection H. Tactic Notation "inject" hyp(H) "as" ident(X1) := injection H; intros X1. Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) := injection H; intros X1 X2. Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) ident(X3) := injection H; intros X1 X2 X3. Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) ident(X3) ident(X4) := injection H; intros X1 X2 X3 X4. Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) := injection H; intros X1 X2 X3 X4 X5. (* ---------------------------------------------------------------------- *) (** ** Inversion and injection with substitution --rough implementation *) (** The tactics [inversions] and [injections] provided in this section are similar to [inverts] and [injects] except that they perform substitution on all equalities from the context and not only the ones freshly generated. The counterpart is that they have simpler implementations. DEPRECATED: these tactics should no longer be used. *) (** [inversions keep H] is the same as [inversions H] but it does not clear hypothesis [H]. *) Tactic Notation "inversions" "keep" hyp(H) := inversion H; subst. (** [inversions H] is a shortcut for [inversion H] followed by [subst] and [clear H]. It is a rough implementation of [inverts keep H] which behave badly when the proof context already contains equalities. It is provided in case the better implementation turns out to be too slow. *) Tactic Notation "inversions" hyp(H) := inversion H; subst; try clear H. (** [injections keep H] is the same as [injection H] followed by [intros] and [subst]. It is a rough implementation of [injects keep H] which behave badly when the proof context already contains equalities, or when the goal starts with a forall or an implication. *) Tactic Notation "injections" "keep" hyp(H) := injection H; intros; subst. (** [injections H] is the same as [injection H] followed by [clear H] and [intros] and [subst]. It is a rough implementation of [injects keep H] which behave badly when the proof context already contains equalities, or when the goal starts with a forall or an implication. *) Tactic Notation "injections" "keep" hyp(H) := injection H; clear H; intros; subst. (* ---------------------------------------------------------------------- *) (** ** Case analysis *) (** [cases] is similar to [case_eq E] except that it generates the equality in the context and not in the goal, and generates the equality the other way round. The syntax [cases E as H] allows specifying the name [H] of that hypothesis. *) Tactic Notation "cases" constr(E) "as" ident(H) := let X := fresh "TEMP" in set (X := E) in *; def_to_eq_sym X H E; destruct X. Tactic Notation "cases" constr(E) := let H := fresh "Eq" in cases E as H. (** [case_if_post H] is to be defined later as a tactic to clean up hypothesis [H] and the goal. By defaults, it looks for obvious contradictions. Currently, this tactic is extended in LibReflect to clean up boolean propositions. *) Ltac case_if_post H := tryfalse. (** [case_if] looks for a pattern of the form [if ?B then ?E1 else ?E2] in the goal, and perform a case analysis on [B] by calling [destruct B]. Subgoals containing a contradiction are discarded. [case_if] looks in the goal first, and otherwise in the first hypothesis that contains an [if] statement. [case_if in H] can be used to specify which hypothesis to consider. Syntaxes [case_if as Eq] and [case_if in H as Eq] allows to name the hypothesis coming from the case analysis. *) Ltac case_if_on_tactic_core E Eq := match type of E with | {_}+{_} => destruct E as [Eq | Eq] | _ => let X := fresh "TEMP" in sets_eq <- X Eq: E; destruct X end. Ltac case_if_on_tactic E Eq := case_if_on_tactic_core E Eq; case_if_post Eq. Tactic Notation "case_if_on" constr(E) "as" simple_intropattern(Eq) := case_if_on_tactic E Eq. Tactic Notation "case_if" "as" simple_intropattern(Eq) := match goal with | |- context [if ?B then _ else _] => case_if_on B as Eq | K: context [if ?B then _ else _] |- _ => case_if_on B as Eq end. Tactic Notation "case_if" "in" hyp(H) "as" simple_intropattern(Eq) := match type of H with context [if ?B then _ else _] => case_if_on B as Eq end. Tactic Notation "case_if" := let Eq := fresh "C" in case_if as Eq. Tactic Notation "case_if" "in" hyp(H) := let Eq := fresh "C" in case_if in H as Eq. (** [cases_if] is similar to [case_if] with two main differences: if it creates an equality of the form [x = y] and then substitutes it in the goal *) Ltac cases_if_on_tactic_core E Eq := match type of E with | {_}+{_} => destruct E as [Eq|Eq]; try subst_hyp Eq | _ => let X := fresh "TEMP" in sets_eq <- X Eq: E; destruct X end. Ltac cases_if_on_tactic E Eq := cases_if_on_tactic_core E Eq; tryfalse; case_if_post Eq. Tactic Notation "cases_if_on" constr(E) "as" simple_intropattern(Eq) := cases_if_on_tactic E Eq. Tactic Notation "cases_if" "as" simple_intropattern(Eq) := match goal with | |- context [if ?B then _ else _] => cases_if_on B as Eq | K: context [if ?B then _ else _] |- _ => cases_if_on B as Eq end. Tactic Notation "cases_if" "in" hyp(H) "as" simple_intropattern(Eq) := match type of H with context [if ?B then _ else _] => cases_if_on B as Eq end. Tactic Notation "cases_if" := let Eq := fresh "C" in cases_if as Eq. Tactic Notation "cases_if" "in" hyp(H) := let Eq := fresh "C" in cases_if in H as Eq. (** [case_ifs] is like [repeat case_if] *) Ltac case_ifs_core := repeat case_if. Tactic Notation "case_ifs" := case_ifs_core. (** [destruct_if] looks for a pattern of the form [if ?B then ?E1 else ?E2] in the goal, and perform a case analysis on [B] by calling [destruct B]. It looks in the goal first, and otherwise in the first hypothesis that contains an [if] statement. *) Ltac destruct_if_post := tryfalse. Tactic Notation "destruct_if" "as" simple_intropattern(Eq1) simple_intropattern(Eq2) := match goal with | |- context [if ?B then _ else _] => destruct B as [Eq1|Eq2] | K: context [if ?B then _ else _] |- _ => destruct B as [Eq1|Eq2] end; destruct_if_post. Tactic Notation "destruct_if" "in" hyp(H) "as" simple_intropattern(Eq1) simple_intropattern(Eq2) := match type of H with context [if ?B then _ else _] => destruct B as [Eq1|Eq2] end; destruct_if_post. Tactic Notation "destruct_if" "as" simple_intropattern(Eq) := destruct_if as Eq Eq. Tactic Notation "destruct_if" "in" hyp(H) "as" simple_intropattern(Eq) := destruct_if in H as Eq Eq. Tactic Notation "destruct_if" := let Eq := fresh "C" in destruct_if as Eq Eq. Tactic Notation "destruct_if" "in" hyp(H) := let Eq := fresh "C" in destruct_if in H as Eq Eq. (** ---BROKEN since v8.5beta2. TODO: cleanup. [destruct_head_match] performs a case analysis on the argument of the head pattern matching when the goal has the form [match ?E with ...] or [match ?E with ... = _] or [_ = match ?E with ...]. Due to the limits of Ltac, this tactic will not fail if a match does not occur. Instead, it might perform a case analysis on an unspecified subterm from the goal. Warning: experimental. *) Ltac find_head_match T := match T with context [?E] => match T with | E => fail 1 | _ => constr:(E) end end. Ltac destruct_head_match_core cont := match goal with | |- ?T1 = ?T2 => first [ let E := find_head_match T1 in cont E | let E := find_head_match T2 in cont E ] | |- ?T1 => let E := find_head_match T1 in cont E end; destruct_if_post. Tactic Notation "destruct_head_match" "as" simple_intropattern(I) := destruct_head_match_core ltac:(fun E => destruct E as I). Tactic Notation "destruct_head_match" := destruct_head_match_core ltac:(fun E => destruct E). (**--provided for compatibility with [remember] *) (** [cases' E] is similar to [case_eq E] except that it generates the equality in the context and not in the goal. The syntax [cases' E as H] allows specifying the name [H] of that hypothesis. *) Tactic Notation "cases'" constr(E) "as" ident(H) := let X := fresh "TEMP" in set (X := E) in *; def_to_eq X H E; destruct X. Tactic Notation "cases'" constr(E) := let x := fresh "Eq" in cases' E as H. (** [cases_if'] is similar to [cases_if] except that it generates the symmetric equality. *) Ltac cases_if_on' E Eq := match type of E with | {_}+{_} => destruct E as [Eq|Eq]; try subst_hyp Eq | _ => let X := fresh "TEMP" in sets_eq X Eq: E; destruct X end; case_if_post Eq. Tactic Notation "cases_if'" "as" simple_intropattern(Eq) := match goal with | |- context [if ?B then _ else _] => cases_if_on' B Eq | K: context [if ?B then _ else _] |- _ => cases_if_on' B Eq end. Tactic Notation "cases_if'" := let Eq := fresh "C" in cases_if' as Eq. (* ********************************************************************** *) (** * Induction *) (** [inductions E] is a shorthand for [dependent induction E]. [inductions E gen X1 .. XN] is a shorthand for [dependent induction E generalizing X1 .. XN]. *) Require Import Coq.Program.Equality. Ltac inductions_post := unfold eq' in *. Tactic Notation "inductions" ident(E) := dependent induction E; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) := dependent induction E generalizing X1; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) := dependent induction E generalizing X1 X2; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) ident(X3) := dependent induction E generalizing X1 X2 X3; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) ident(X3) ident(X4) := dependent induction E generalizing X1 X2 X3 X4; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) := dependent induction E generalizing X1 X2 X3 X4 X5; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) := dependent induction E generalizing X1 X2 X3 X4 X5 X6; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) := dependent induction E generalizing X1 X2 X3 X4 X5 X6 X7; inductions_post. Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) ident(X8) := dependent induction E generalizing X1 X2 X3 X4 X5 X6 X7 X8; inductions_post. (** [induction_wf IH: E X] is used to apply the well-founded induction principle, for a given well-founded relation. It applies to a goal [PX] where [PX] is a proposition on [X]. First, it sets up the goal in the form [(fun a => P a) X], using [pattern X], and then it applies the well-founded induction principle instantiated on [E]. Here [E] may be either: - a proof of [wf R] for [R] of type [A->A->Prop] - a binary relation of type [A->A->Prop] - a measure of type [A -> nat] // only when LibWf is used Syntaxes [induction_wf: E X] and [induction_wf E X]. *) (* DEPRECATED Tactic Notation "induction_wf" ident(IH) ":" constr(E) ident(X) := pattern X; apply (well_founded_ind E); clear X; intros X IH. *) (* Tactic is later extended in module LibWf *) Ltac induction_wf_core_then IH E X cont := let T := type of E in let T := eval hnf in T in let clearX tt := first [ clear X | fail 3 "the variable on which the induction is done appears in the hypotheses" ] in match T with (* Support for measures from LibWf, add this: | ?A -> nat => induction_wf_core_then IH (wf_measure E) X cont *) | ?A -> ?A -> Prop => pattern X; first [ applys well_founded_ind E; clearX tt; [ (* Support for [wf] from LibWf change well_founded with wf; auto with wf *) | intros X IH; cont tt ] | fail 2 ] | _ => pattern X; applys well_founded_ind E; clearX tt; intros X IH; cont tt end. Ltac induction_wf_core IH E X := induction_wf_core_then IH E X ltac:(fun _ => idtac). Tactic Notation "induction_wf" ident(IH) ":" constr(E) ident(X) := induction_wf_core IH E X. Tactic Notation "induction_wf" ":" constr(E) ident(X) := let IH := fresh "IH" in induction_wf IH: E X. Tactic Notation "induction_wf" ":" constr(E) ident(X) := induction_wf: E X. (** Induction on the height of a derivation: the helper tactic [induct_height] helps proving the equivalence of the auxiliary judgment that includes a counter for the maximal height (see LibTacticsDemos for an example) *) Require Import Coq.Arith.Compare_dec. Require Import Lia. Lemma induct_height_max2 : forall n1 n2 : nat, exists n, n1 < n /\ n2 < n. Proof using. intros. destruct (lt_dec n1 n2). exists (S n2). lia. exists (S n1). lia. Qed. Ltac induct_height_step x := match goal with | H: exists _, _ |- _ => let n := fresh "n" in let y := fresh "x" in destruct H as [n ?]; forwards (y&?&?): induct_height_max2 n x; induct_height_step y | _ => exists (S x); eauto end. Ltac induct_height := induct_height_step O. (* ********************************************************************** *) (** * Coinduction *) (** Tactic [cofixs IH] is like [cofix IH] except that the coinduction hypothesis is tagged in the form [IH: COIND P] instead of being just [IH: P]. This helps other tactics clearing the coinduction hypothesis using [clear_coind] *) Definition COIND (P:Prop) := P. Tactic Notation "cofixs" ident(IH) := cofix IH; match type of IH with ?P => change P with (COIND P) in IH end. (** Tactic [clear_coind] clears all the coinduction hypotheses, assuming that they have been tagged *) Ltac clear_coind := repeat match goal with H: COIND _ |- _ => clear H end. (** Tactic [abstracts tac] is like [abstract tac] except that it clears the coinduction hypotheses so that the productivity check will be happy. For example, one can use [abstracts omega] to obtain the same behavior as [omega] but with an auxiliary lemma being generated. *) Tactic Notation "abstracts" tactic(tac) := clear_coind; tac. (* ********************************************************************** *) (** * Decidable equality *) (** [decides_equality] is the same as [decide equality] excepts that it is able to unfold definitions at head of the current goal. *) Ltac decides_equality_tactic := first [ decide equality | progress(unfolds); decides_equality_tactic ]. Tactic Notation "decides_equality" := decides_equality_tactic. (* ********************************************************************** *) (** * Equivalence *) (** [iff H] can be used to prove an equivalence [P <-> Q] and name [H] the hypothesis obtained in each case. The syntaxes [iff] and [iff H1 H2] are also available to specify zero or two names. The tactic [iff <- H] swaps the two subgoals, i.e. produces (Q -> P) as first subgoal. *) Lemma iff_intro_swap : forall (P Q : Prop), (Q -> P) -> (P -> Q) -> (P <-> Q). Proof using. intuition. Qed. Tactic Notation "iff" simple_intropattern(H1) simple_intropattern(H2) := split; [ intros H1 | intros H2 ]. Tactic Notation "iff" simple_intropattern(H) := iff H H. Tactic Notation "iff" := let H := fresh "H" in iff H. Tactic Notation "iff" "<-" simple_intropattern(H1) simple_intropattern(H2) := apply iff_intro_swap; [ intros H1 | intros H2 ]. Tactic Notation "iff" "<-" simple_intropattern(H) := iff <- H H. Tactic Notation "iff" "<-" := let H := fresh "H" in iff <- H. (* ********************************************************************** *) (** * N-ary Conjunctions and Disjunctions *) (* ---------------------------------------------------------------------- *) (** N-ary Conjunctions Splitting in Goals *) (** Underlying implementation of [splits]. *) Ltac splits_tactic N := match N with | O => fail | S O => idtac | S ?N' => split; [| splits_tactic N'] end. Ltac unfold_goal_until_conjunction := match goal with | |- _ /\ _ => idtac | _ => progress(unfolds); unfold_goal_until_conjunction end. Ltac get_term_conjunction_arity T := match T with | _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(8) | _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(7) | _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(6) | _ /\ _ /\ _ /\ _ /\ _ => constr:(5) | _ /\ _ /\ _ /\ _ => constr:(4) | _ /\ _ /\ _ => constr:(3) | _ /\ _ => constr:(2) | _ -> ?T' => get_term_conjunction_arity T' | _ => let P := get_head T in let T' := eval unfold P in T in match T' with | T => fail 1 | _ => get_term_conjunction_arity T' end (* --TODO: warning this can loop... *) end. Ltac get_goal_conjunction_arity := match goal with |- ?T => get_term_conjunction_arity T end. (** [splits] applies to a goal of the form [(T1 /\ .. /\ TN)] and destruct it into [N] subgoals [T1] .. [TN]. If the goal is not a conjunction, then it unfolds the head definition. *) Tactic Notation "splits" := unfold_goal_until_conjunction; let N := get_goal_conjunction_arity in splits_tactic N. (** [splits N] is similar to [splits], except that it will unfold as many definitions as necessary to obtain an [N]-ary conjunction. *) Tactic Notation "splits" constr(N) := let N := number_to_nat N in splits_tactic N. (* ---------------------------------------------------------------------- *) (** N-ary Conjunctions Deconstruction *) (** Underlying implementation of [destructs]. *) Ltac destructs_conjunction_tactic N T := match N with | 2 => destruct T as [? ?] | 3 => destruct T as [? [? ?]] | 4 => destruct T as [? [? [? ?]]] | 5 => destruct T as [? [? [? [? ?]]]] | 6 => destruct T as [? [? [? [? [? ?]]]]] | 7 => destruct T as [? [? [? [? [? [? ?]]]]]] end. (** [destructs T] allows destructing a term [T] which is a N-ary conjunction. It is equivalent to [destruct T as (H1 .. HN)], except that it does not require to manually specify N different names. *) Tactic Notation "destructs" constr(T) := let TT := type of T in let N := get_term_conjunction_arity TT in destructs_conjunction_tactic N T. (** [destructs N T] is equivalent to [destruct T as (H1 .. HN)], except that it does not require to manually specify N different names. Remark that it is not restricted to N-ary conjunctions. *) Tactic Notation "destructs" constr(N) constr(T) := let N := number_to_nat N in destructs_conjunction_tactic N T. (* ---------------------------------------------------------------------- *) (** Proving goals which are N-ary disjunctions *) (** Underlying implementation of [branch]. *) Ltac branch_tactic K N := match constr:((K,N)) with | (_,0) => fail 1 | (0,_) => fail 1 | (1,1) => idtac | (1,_) => left | (S ?K', S ?N') => right; branch_tactic K' N' end. Ltac unfold_goal_until_disjunction := match goal with | |- _ \/ _ => idtac | _ => progress(unfolds); unfold_goal_until_disjunction end. Ltac get_term_disjunction_arity T := match T with | _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(8) | _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(7) | _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(6) | _ \/ _ \/ _ \/ _ \/ _ => constr:(5) | _ \/ _ \/ _ \/ _ => constr:(4) | _ \/ _ \/ _ => constr:(3) | _ \/ _ => constr:(2) | _ -> ?T' => get_term_disjunction_arity T' | _ => let P := get_head T in let T' := eval unfold P in T in match T' with | T => fail 1 | _ => get_term_disjunction_arity T' end end. Ltac get_goal_disjunction_arity := match goal with |- ?T => get_term_disjunction_arity T end. (** [branch N] applies to a goal of the form [P1 \/ ... \/ PK \/ ... \/ PN] and leaves the goal [PK]. It only able to unfold the head definition (if there is one), but for more complex unfolding one should use the tactic [branch K of N]. *) Tactic Notation "branch" constr(K) := let K := number_to_nat K in unfold_goal_until_disjunction; let N := get_goal_disjunction_arity in branch_tactic K N. (** [branch K of N] is similar to [branch K] except that the arity of the disjunction [N] is given manually, and so this version of the tactic is able to unfold definitions. In other words, applies to a goal of the form [P1 \/ ... \/ PK \/ ... \/ PN] and leaves the goal [PK]. *) Tactic Notation "branch" constr(K) "of" constr(N) := let N := number_to_nat N in let K := number_to_nat K in branch_tactic K N. (* ---------------------------------------------------------------------- *) (** N-ary Disjunction Deconstruction *) (** Underlying implementation of [branches]. *) Ltac destructs_disjunction_tactic N T := match N with | 2 => destruct T as [? | ?] | 3 => destruct T as [? | [? | ?]] | 4 => destruct T as [? | [? | [? | ?]]] | 5 => destruct T as [? | [? | [? | [? | ?]]]] end. (** [branches T] allows destructing a term [T] which is a N-ary disjunction. It is equivalent to [destruct T as [ H1 | .. | HN ] ], and produces [N] subgoals corresponding to the [N] possible cases. *) Tactic Notation "branches" constr(T) := let TT := type of T in let N := get_term_disjunction_arity TT in destructs_disjunction_tactic N T. (** [branches N T] is the same as [branches T] except that the arity is forced to [N]. This version is useful to unfold definitions on the fly. *) Tactic Notation "branches" constr(N) constr(T) := let N := number_to_nat N in destructs_disjunction_tactic N T. (** [branches] automatically finds a hypothesis [h] that is a disjunction and destructs it. *) Tactic Notation "branches" := match goal with h: _ \/ _ |- _ => branches h end. (* ---------------------------------------------------------------------- *) (** N-ary Existentials *) (* Underlying implementation of [exists]. *) Ltac get_term_existential_arity T := match T with | exists x1 x2 x3 x4 x5 x6 x7 x8, _ => constr:(8) | exists x1 x2 x3 x4 x5 x6 x7, _ => constr:(7) | exists x1 x2 x3 x4 x5 x6, _ => constr:(6) | exists x1 x2 x3 x4 x5, _ => constr:(5) | exists x1 x2 x3 x4, _ => constr:(4) | exists x1 x2 x3, _ => constr:(3) | exists x1 x2, _ => constr:(2) | exists x1, _ => constr:(1) | _ -> ?T' => get_term_existential_arity T' | _ => let P := get_head T in let T' := eval unfold P in T in match T' with | T => fail 1 | _ => get_term_existential_arity T' end end. Ltac get_goal_existential_arity := match goal with |- ?T => get_term_existential_arity T end. (** [exists T1 ... TN] is a shorthand for [exists T1; ...; exists TN]. It is intended to prove goals of the form [exist X1 .. XN, P]. If an argument provided is [__] (double underscore), then an evar is introduced. [exists T1 .. TN ___] is equivalent to [exists T1 .. TN __ __ __] with as many [__] as possible. *) Tactic Notation "exists_original" constr(T1) := exists T1. Tactic Notation "exists" constr(T1) := match T1 with | ltac_wild => esplit | ltac_wilds => repeat esplit | _ => exists T1 end. Tactic Notation "exists" constr(T1) constr(T2) := exists T1; exists T2. Tactic Notation "exists" constr(T1) constr(T2) constr(T3) := exists T1; exists T2; exists T3. Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4) := exists T1; exists T2; exists T3; exists T4. Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) := exists T1; exists T2; exists T3; exists T4; exists T5. Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) constr(T6) := exists T1; exists T2; exists T3; exists T4; exists T5; exists T6. (** For compatibility with Coq syntax, [exists T1, .., TN] is also provided. *) Tactic Notation "exists" constr(T1) "," constr(T2) := exists T1 T2. Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) := exists T1 T2 T3. Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) := exists T1 T2 T3 T4. Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) "," constr(T5) := exists T1 T2 T3 T4 T5. Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) "," constr(T5) "," constr(T6) := exists T1 T2 T3 T4 T5 T6. (* The tactic [exists___ N] is short for [exists __ ... __] with [N] double-underscores. The tactic [exists] is equivalent to calling [exists___ N], where the value of [N] is obtained by counting the number of existentials syntactically present at the head of the goal. The behaviour of [exists] differs from that of [exists ___] is the case where the goal is a definition which yields an existential only after unfolding. *) Tactic Notation "exists___" constr(N) := let rec aux N := match N with | 0 => idtac | S ?N' => esplit; aux N' end in let N := number_to_nat N in aux N. (* --TODO: deprecated *) Tactic Notation "exists___" := let N := get_goal_existential_arity in exists___ N. (* --TODO: does not seem to work *) Tactic Notation "exists" := exists___. (* --TODO: [exists_all] is the new syntax for [exists___] *) Tactic Notation "exists_all" := exists___. (* ---------------------------------------------------------------------- *) (** Existentials and conjunctions in hypotheses *) (** [unpack] or [unpack H] destructs conjunctions and existentials in all or one hypothesis. *) Ltac unpack_core := repeat match goal with | H: _ /\ _ |- _ => destruct H | H: exists (varname: _), _ |- _ => (* kludge to preserve the name of the quantified variable *) let name := fresh varname in destruct H as [name ?] end. Ltac unpack_hypothesis H := try match type of H with | _ /\ _ => let h1 := fresh "TEMP" in let h2 := fresh "TEMP" in destruct H as [ h1 h2 ]; unpack_hypothesis h1; unpack_hypothesis h2 | exists (varname: _), _ => (* kludge to preserve the name of the quantified variable *) let name := fresh varname in let body := fresh "TEMP" in destruct H as [name body]; unpack_hypothesis body end. Tactic Notation "unpack" := unpack_core. Tactic Notation "unpack" constr(H) := unpack_hypothesis H. (* ********************************************************************** *) (** * Tactics to prove typeclass instances *) (** [typeclass] is an automation tactic specialized for finding typeclass instances. *) Tactic Notation "typeclass" := let go _ := eauto with typeclass_instances in solve [ go tt | constructor; go tt ]. (** [solve_typeclass] is a simpler version of [typeclass], to use in hint tactics for resolving instances *) Tactic Notation "solve_typeclass" := solve [ eauto with typeclass_instances ]. (* ********************************************************************** *) (** * Tactics to invoke automation *) (* ---------------------------------------------------------------------- *) (** ** Definitions for parsing compatibility *) Tactic Notation "f_equal" := f_equal. Tactic Notation "constructor" := constructor. Tactic Notation "simple" := simpl. Tactic Notation "split" := split. Tactic Notation "right" := right. Tactic Notation "left" := left. (* ---------------------------------------------------------------------- *) (** ** [hint] to add hints local to a lemma *) (** [hint E] adds [E] as an hypothesis so that automation can use it. Syntax [hint E1,..,EN] is available *) Tactic Notation "hint" constr(E) := let H := fresh "Hint" in lets H: E. Tactic Notation "hint" constr(E1) "," constr(E2) := hint E1; hint E2. Tactic Notation "hint" constr(E1) "," constr(E2) "," constr(E3) := hint E1; hint E2; hint(E3). Tactic Notation "hint" constr(E1) "," constr(E2) "," constr(E3) "," constr(E4) := hint E1; hint E2; hint(E3); hint(E4 ). (* ---------------------------------------------------------------------- *) (** ** [jauto], a new automation tactics *) (** [jauto] is better at [intuition eauto] because it can open existentials from the context. In the same time, [jauto] can be faster than [intuition eauto] because it does not destruct disjunctions from the context. The strategy of [jauto] can be summarized as follows: - open all the existentials and conjunctions from the context - call esplit and split on the existentials and conjunctions in the goal - call eauto. *) Tactic Notation "jauto" := try solve [ jauto_set; eauto ]. Tactic Notation "jauto_fast" := try solve [ auto | eauto | jauto ]. (** [iauto] is a shorthand for [intuition eauto] *) Tactic Notation "iauto" := try solve [intuition eauto]. (* ---------------------------------------------------------------------- *) (** ** Definitions of automation tactics *) (** The two following tactics defined the default behaviour of "light automation" and "strong automation". These tactics may be redefined at any time using the syntax [Ltac .. ::= ..]. *) (** [auto_tilde] is the tactic which will be called each time a symbol [~] is used after a tactic. *) Ltac auto_tilde_default := auto. Ltac auto_tilde := auto_tilde_default. (** [auto_star] is the tactic which will be called each time a symbol [*] is used after a tactic. *) Ltac auto_star_default := try solve [ auto | eauto | intuition eauto ]. (* --TODO: should be jauto *) Ltac auto_star := auto_star_default. (** [autos~] is a notation for tactic [auto_tilde]. It may be followed by lemmas (or proofs terms) which auto will be able to use for solving the goal. *) (** [autos] is an alias for [autos~] *) Tactic Notation "autos" := auto_tilde. Tactic Notation "autos" "~" := auto_tilde. Tactic Notation "autos" "~" constr(E1) := lets: E1; auto_tilde. Tactic Notation "autos" "~" constr(E1) constr(E2) := lets: E1; lets: E2; auto_tilde. Tactic Notation "autos" "~" constr(E1) constr(E2) constr(E3) := lets: E1; lets: E2; lets: E3; auto_tilde. (** [autos*] is a notation for tactic [auto_star]. It may be followed by lemmas (or proofs terms) which auto will be able to use for solving the goal. *) Tactic Notation "autos" "*" := auto_star. Tactic Notation "autos" "*" constr(E1) := lets: E1; auto_star. Tactic Notation "autos" "*" constr(E1) constr(E2) := lets: E1; lets: E2; auto_star. Tactic Notation "autos" "*" constr(E1) constr(E2) constr(E3) := lets: E1; lets: E2; lets: E3; auto_star. (** [auto_false] is a version of [auto] able to spot some contradictions. There is an ad-hoc support for goals in [<->]: split is called first. [auto_false~] and [auto_false*] are also available. *) Ltac auto_false_base cont := try solve [ intros_all; try match goal with |- _ <-> _ => split end; solve [ cont tt | intros_all; false; cont tt ] ]. Tactic Notation "auto_false" := auto_false_base ltac:(fun tt => auto). Tactic Notation "auto_false" "~" := auto_false_base ltac:(fun tt => auto_tilde). Tactic Notation "auto_false" "*" := auto_false_base ltac:(fun tt => auto_star). Tactic Notation "dauto" := dintuition eauto. (* ---------------------------------------------------------------------- *) (** ** Parsing for light automation *) (** Any tactic followed by the symbol [~] will have [auto_tilde] called on all of its subgoals. Three exceptions: - [cuts] and [asserts] only call [auto] on their first subgoal, - [apply~] relies on [sapply] rather than [apply], - [tryfalse~] is defined as [tryfalse by auto_tilde]. Some builtin tactics are not defined using tactic notations and thus cannot be extended, e.g. [simpl] and [unfold]. For these, notation such as [simpl~] will not be available. *) Tactic Notation "equates" "~" constr(E) := equates E; auto_tilde. Tactic Notation "equates" "~" constr(n1) constr(n2) := equates n1 n2; auto_tilde. Tactic Notation "equates" "~" constr(n1) constr(n2) constr(n3) := equates n1 n2 n3; auto_tilde. Tactic Notation "equates" "~" constr(n1) constr(n2) constr(n3) constr(n4) := equates n1 n2 n3 n4; auto_tilde. Tactic Notation "applys_eq" "~" constr(H) constr(E) := applys_eq H E; auto_tilde. Tactic Notation "applys_eq" "~" constr(H) constr(n1) constr(n2) := applys_eq H n1 n2; auto_tilde. Tactic Notation "applys_eq" "~" constr(H) constr(n1) constr(n2) constr(n3) := applys_eq H n1 n2 n3; auto_tilde. Tactic Notation "applys_eq" "~" constr(H) constr(n1) constr(n2) constr(n3) constr(n4) := applys_eq H n1 n2 n3 n4; auto_tilde. Tactic Notation "apply" "~" constr(H) := sapply H; auto_tilde. Tactic Notation "destruct" "~" constr(H) := destruct H; auto_tilde. Tactic Notation "destruct" "~" constr(H) "as" simple_intropattern(I) := destruct H as I; auto_tilde. Tactic Notation "f_equal" "~" := f_equal; auto_tilde. Tactic Notation "induction" "~" constr(H) := induction H; auto_tilde. Tactic Notation "inversion" "~" constr(H) := inversion H; auto_tilde. Tactic Notation "split" "~" := split; auto_tilde. Tactic Notation "subst" "~" := subst; auto_tilde. Tactic Notation "right" "~" := right; auto_tilde. Tactic Notation "left" "~" := left; auto_tilde. Tactic Notation "constructor" "~" := constructor; auto_tilde. Tactic Notation "constructors" "~" := constructors; auto_tilde. Tactic Notation "false" "~" := false; auto_tilde. Tactic Notation "false" "~" constr(E) := false_then E ltac:(fun _ => auto_tilde). Tactic Notation "false" "~" constr(E0) constr(E1) := false~ (>> E0 E1). Tactic Notation "false" "~" constr(E0) constr(E1) constr(E2) := false~ (>> E0 E1 E2). Tactic Notation "false" "~" constr(E0) constr(E1) constr(E2) constr(E3) := false~ (>> E0 E1 E2 E3). Tactic Notation "false" "~" constr(E0) constr(E1) constr(E2) constr(E3) constr(E4) := false~ (>> E0 E1 E2 E3 E4). Tactic Notation "tryfalse" "~" := try solve [ false~ ]. Tactic Notation "asserts" "~" simple_intropattern(H) ":" constr(E) := asserts H: E; [ auto_tilde | idtac ]. Tactic Notation "asserts" "~" ":" constr(E) := let H := fresh "H" in asserts~ H: E. Tactic Notation "cuts" "~" simple_intropattern(H) ":" constr(E) := cuts H: E; [ auto_tilde | idtac ]. Tactic Notation "cuts" "~" ":" constr(E) := cuts: E; [ auto_tilde | idtac ]. Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E) := lets I: E; auto_tilde. Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0) constr(A1) := lets I: E0 A1; auto_tilde. Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) := lets I: E0 A1 A2; auto_tilde. Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) := lets I: E0 A1 A2 A3; auto_tilde. Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := lets I: E0 A1 A2 A3 A4; auto_tilde. Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets I: E0 A1 A2 A3 A4 A5; auto_tilde. Tactic Notation "lets" "~" ":" constr(E) := lets: E; auto_tilde. Tactic Notation "lets" "~" ":" constr(E0) constr(A1) := lets: E0 A1; auto_tilde. Tactic Notation "lets" "~" ":" constr(E0) constr(A1) constr(A2) := lets: E0 A1 A2; auto_tilde. Tactic Notation "lets" "~" ":" constr(E0) constr(A1) constr(A2) constr(A3) := lets: E0 A1 A2 A3; auto_tilde. Tactic Notation "lets" "~" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := lets: E0 A1 A2 A3 A4; auto_tilde. Tactic Notation "lets" "~" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets: E0 A1 A2 A3 A4 A5; auto_tilde. Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E) := forwards I: E; auto_tilde. Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0) constr(A1) := forwards I: E0 A1; auto_tilde. Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) := forwards I: E0 A1 A2; auto_tilde. Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) := forwards I: E0 A1 A2 A3; auto_tilde. Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := forwards I: E0 A1 A2 A3 A4; auto_tilde. Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := forwards I: E0 A1 A2 A3 A4 A5; auto_tilde. Tactic Notation "forwards" "~" ":" constr(E) := forwards: E; auto_tilde. Tactic Notation "forwards" "~" ":" constr(E0) constr(A1) := forwards: E0 A1; auto_tilde. Tactic Notation "forwards" "~" ":" constr(E0) constr(A1) constr(A2) := forwards: E0 A1 A2; auto_tilde. Tactic Notation "forwards" "~" ":" constr(E0) constr(A1) constr(A2) constr(A3) := forwards: E0 A1 A2 A3; auto_tilde. Tactic Notation "forwards" "~" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := forwards: E0 A1 A2 A3 A4; auto_tilde. Tactic Notation "forwards" "~" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := forwards: E0 A1 A2 A3 A4 A5; auto_tilde. Tactic Notation "applys" "~" constr(H) := sapply H; auto_tilde. (*todo?*) Tactic Notation "applys" "~" constr(E0) constr(A1) := applys E0 A1; auto_tilde. Tactic Notation "applys" "~" constr(E0) constr(A1) := applys E0 A1; auto_tilde. Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) := applys E0 A1 A2; auto_tilde. Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) constr(A3) := applys E0 A1 A2 A3; auto_tilde. Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := applys E0 A1 A2 A3 A4; auto_tilde. Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := applys E0 A1 A2 A3 A4 A5; auto_tilde. Tactic Notation "specializes" "~" hyp(H) := specializes H; auto_tilde. Tactic Notation "specializes" "~" hyp(H) constr(A1) := specializes H A1; auto_tilde. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) := specializes H A1 A2; auto_tilde. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) := specializes H A1 A2 A3; auto_tilde. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) := specializes H A1 A2 A3 A4; auto_tilde. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := specializes H A1 A2 A3 A4 A5; auto_tilde. Tactic Notation "fapply" "~" constr(E) := fapply E; auto_tilde. Tactic Notation "sapply" "~" constr(E) := sapply E; auto_tilde. Tactic Notation "logic" "~" constr(E) := logic_base E ltac:(fun _ => auto_tilde). Tactic Notation "intros_all" "~" := intros_all; auto_tilde. Tactic Notation "unfolds" "~" := unfolds; auto_tilde. Tactic Notation "unfolds" "~" constr(F1) := unfolds F1; auto_tilde. Tactic Notation "unfolds" "~" constr(F1) "," constr(F2) := unfolds F1, F2; auto_tilde. Tactic Notation "unfolds" "~" constr(F1) "," constr(F2) "," constr(F3) := unfolds F1, F2, F3; auto_tilde. Tactic Notation "unfolds" "~" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) := unfolds F1, F2, F3, F4; auto_tilde. Tactic Notation "simple" "~" := simpl; auto_tilde. Tactic Notation "simple" "~" "in" hyp(H) := simpl in H; auto_tilde. Tactic Notation "simpls" "~" := simpls; auto_tilde. Tactic Notation "hnfs" "~" := hnfs; auto_tilde. Tactic Notation "hnfs" "~" "in" hyp(H) := hnf in H; auto_tilde. Tactic Notation "substs" "~" := substs; auto_tilde. Tactic Notation "intro_hyp" "~" hyp(H) := subst_hyp H; auto_tilde. Tactic Notation "intro_subst" "~" := intro_subst; auto_tilde. Tactic Notation "subst_eq" "~" constr(E) := subst_eq E; auto_tilde. Tactic Notation "rewrite" "~" constr(E) := rewrite E; auto_tilde. Tactic Notation "rewrite" "~" "<-" constr(E) := rewrite <- E; auto_tilde. Tactic Notation "rewrite" "~" constr(E) "in" hyp(H) := rewrite E in H; auto_tilde. Tactic Notation "rewrite" "~" "<-" constr(E) "in" hyp(H) := rewrite <- E in H; auto_tilde. Tactic Notation "rewrites" "~" constr(E) := rewrites E; auto_tilde. Tactic Notation "rewrites" "~" constr(E) "in" hyp(H) := rewrites E in H; auto_tilde. Tactic Notation "rewrites" "~" constr(E) "in" "*" := rewrites E in *; auto_tilde. Tactic Notation "rewrites" "~" "<-" constr(E) := rewrites <- E; auto_tilde. Tactic Notation "rewrites" "~" "<-" constr(E) "in" hyp(H) := rewrites <- E in H; auto_tilde. Tactic Notation "rewrites" "~" "<-" constr(E) "in" "*" := rewrites <- E in *; auto_tilde. Tactic Notation "rewrite_all" "~" constr(E) := rewrite_all E; auto_tilde. Tactic Notation "rewrite_all" "~" "<-" constr(E) := rewrite_all <- E; auto_tilde. Tactic Notation "rewrite_all" "~" constr(E) "in" ident(H) := rewrite_all E in H; auto_tilde. Tactic Notation "rewrite_all" "~" "<-" constr(E) "in" ident(H) := rewrite_all <- E in H; auto_tilde. Tactic Notation "rewrite_all" "~" constr(E) "in" "*" := rewrite_all E in *; auto_tilde. Tactic Notation "rewrite_all" "~" "<-" constr(E) "in" "*" := rewrite_all <- E in *; auto_tilde. Tactic Notation "asserts_rewrite" "~" constr(E) := asserts_rewrite E; auto_tilde. Tactic Notation "asserts_rewrite" "~" "<-" constr(E) := asserts_rewrite <- E; auto_tilde. Tactic Notation "asserts_rewrite" "~" constr(E) "in" hyp(H) := asserts_rewrite E in H; auto_tilde. Tactic Notation "asserts_rewrite" "~" "<-" constr(E) "in" hyp(H) := asserts_rewrite <- E in H; auto_tilde. Tactic Notation "asserts_rewrite" "~" constr(E) "in" "*" := asserts_rewrite E in *; auto_tilde. Tactic Notation "asserts_rewrite" "~" "<-" constr(E) "in" "*" := asserts_rewrite <- E in *; auto_tilde. Tactic Notation "cuts_rewrite" "~" constr(E) := cuts_rewrite E; auto_tilde. Tactic Notation "cuts_rewrite" "~" "<-" constr(E) := cuts_rewrite <- E; auto_tilde. Tactic Notation "cuts_rewrite" "~" constr(E) "in" hyp(H) := cuts_rewrite E in H; auto_tilde. Tactic Notation "cuts_rewrite" "~" "<-" constr(E) "in" hyp(H) := cuts_rewrite <- E in H; auto_tilde. Tactic Notation "erewrite" "~" constr(E) := erewrite E; auto_tilde. Tactic Notation "fequal" "~" := fequal; auto_tilde. Tactic Notation "fequals" "~" := fequals; auto_tilde. Tactic Notation "pi_rewrite" "~" constr(E) := pi_rewrite E; auto_tilde. Tactic Notation "pi_rewrite" "~" constr(E) "in" hyp(H) := pi_rewrite E in H; auto_tilde. Tactic Notation "invert" "~" hyp(H) := invert H; auto_tilde. Tactic Notation "inverts" "~" hyp(H) := inverts H; auto_tilde. Tactic Notation "inverts" "~" hyp(E) "as" := inverts E as; auto_tilde. Tactic Notation "injects" "~" hyp(H) := injects H; auto_tilde. Tactic Notation "inversions" "~" hyp(H) := inversions H; auto_tilde. Tactic Notation "cases" "~" constr(E) "as" ident(H) := cases E as H; auto_tilde. Tactic Notation "cases" "~" constr(E) := cases E; auto_tilde. Tactic Notation "case_if" "~" := case_if; auto_tilde. Tactic Notation "case_ifs" "~" := case_ifs; auto_tilde. Tactic Notation "case_if" "~" "in" hyp(H) := case_if in H; auto_tilde. Tactic Notation "cases_if" "~" := cases_if; auto_tilde. Tactic Notation "cases_if" "~" "in" hyp(H) := cases_if in H; auto_tilde. Tactic Notation "destruct_if" "~" := destruct_if; auto_tilde. Tactic Notation "destruct_if" "~" "in" hyp(H) := destruct_if in H; auto_tilde. Tactic Notation "destruct_head_match" "~" := destruct_head_match; auto_tilde. Tactic Notation "cases'" "~" constr(E) "as" ident(H) := cases' E as H; auto_tilde. Tactic Notation "cases'" "~" constr(E) := cases' E; auto_tilde. Tactic Notation "cases_if'" "~" "as" ident(H) := cases_if' as H; auto_tilde. Tactic Notation "cases_if'" "~" := cases_if'; auto_tilde. Tactic Notation "decides_equality" "~" := decides_equality; auto_tilde. Tactic Notation "iff" "~" := iff; auto_tilde. Tactic Notation "iff" "~" simple_intropattern(I) := iff I; auto_tilde. Tactic Notation "splits" "~" := splits; auto_tilde. Tactic Notation "splits" "~" constr(N) := splits N; auto_tilde. Tactic Notation "destructs" "~" constr(T) := destructs T; auto_tilde. Tactic Notation "destructs" "~" constr(N) constr(T) := destructs N T; auto_tilde. Tactic Notation "branch" "~" constr(N) := branch N; auto_tilde. Tactic Notation "branch" "~" constr(K) "of" constr(N) := branch K of N; auto_tilde. Tactic Notation "branches" "~" := branches; auto_tilde. Tactic Notation "branches" "~" constr(T) := branches T; auto_tilde. Tactic Notation "branches" "~" constr(N) constr(T) := branches N T; auto_tilde. Tactic Notation "exists" "~" := exists; auto_tilde. Tactic Notation "exists___" "~" := exists___; auto_tilde. Tactic Notation "exists" "~" constr(T1) := exists T1; auto_tilde. Tactic Notation "exists" "~" constr(T1) constr(T2) := exists T1 T2; auto_tilde. Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) := exists T1 T2 T3; auto_tilde. Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) constr(T4) := exists T1 T2 T3 T4; auto_tilde. Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) := exists T1 T2 T3 T4 T5; auto_tilde. Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) constr(T6) := exists T1 T2 T3 T4 T5 T6; auto_tilde. Tactic Notation "exists" "~" constr(T1) "," constr(T2) := exists T1 T2; auto_tilde. Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) := exists T1 T2 T3; auto_tilde. Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) := exists T1 T2 T3 T4; auto_tilde. Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) "," constr(T5) := exists T1 T2 T3 T4 T5; auto_tilde. Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) "," constr(T5) "," constr(T6) := exists T1 T2 T3 T4 T5 T6; auto_tilde. (* ---------------------------------------------------------------------- *) (** ** Parsing for strong automation *) (** Any tactic followed by the symbol [*] will have [auto*] called on all of its subgoals. The exceptions to these rules are the same as for light automation. Exception: use [subs*] instead of [subst*] if you import the library [Coq.Classes.Equivalence]. *) Tactic Notation "equates" "*" constr(E) := equates E; auto_star. Tactic Notation "equates" "*" constr(n1) constr(n2) := equates n1 n2; auto_star. Tactic Notation "equates" "*" constr(n1) constr(n2) constr(n3) := equates n1 n2 n3; auto_star. Tactic Notation "equates" "*" constr(n1) constr(n2) constr(n3) constr(n4) := equates n1 n2 n3 n4; auto_star. Tactic Notation "applys_eq" "*" constr(H) constr(E) := applys_eq H E; auto_star. Tactic Notation "applys_eq" "*" constr(H) constr(n1) constr(n2) := applys_eq H n1 n2; auto_star. Tactic Notation "applys_eq" "*" constr(H) constr(n1) constr(n2) constr(n3) := applys_eq H n1 n2 n3; auto_star. Tactic Notation "applys_eq" "*" constr(H) constr(n1) constr(n2) constr(n3) constr(n4) := applys_eq H n1 n2 n3 n4; auto_star. Tactic Notation "apply" "*" constr(H) := sapply H; auto_star. Tactic Notation "destruct" "*" constr(H) := destruct H; auto_star. Tactic Notation "destruct" "*" constr(H) "as" simple_intropattern(I) := destruct H as I; auto_star. Tactic Notation "f_equal" "*" := f_equal; auto_star. Tactic Notation "induction" "*" constr(H) := induction H; auto_star. Tactic Notation "inversion" "*" constr(H) := inversion H; auto_star. Tactic Notation "split" "*" := split; auto_star. Tactic Notation "subs" "*" := subst; auto_star. Tactic Notation "subst" "*" := subst; auto_star. Tactic Notation "right" "*" := right; auto_star. Tactic Notation "left" "*" := left; auto_star. Tactic Notation "constructor" "*" := constructor; auto_star. Tactic Notation "constructors" "*" := constructors; auto_star. Tactic Notation "false" "*" := false; auto_star. Tactic Notation "false" "*" constr(E) := false_then E ltac:(fun _ => auto_star). Tactic Notation "false" "*" constr(E0) constr(E1) := false* (>> E0 E1). Tactic Notation "false" "*" constr(E0) constr(E1) constr(E2) := false* (>> E0 E1 E2). Tactic Notation "false" "*" constr(E0) constr(E1) constr(E2) constr(E3) := false* (>> E0 E1 E2 E3). Tactic Notation "false" "*" constr(E0) constr(E1) constr(E2) constr(E3) constr(E4) := false* (>> E0 E1 E2 E3 E4). Tactic Notation "tryfalse" "*" := try solve [ false* ]. Tactic Notation "asserts" "*" simple_intropattern(H) ":" constr(E) := asserts H: E; [ auto_star | idtac ]. Tactic Notation "asserts" "*" ":" constr(E) := let H := fresh "H" in asserts* H: E. Tactic Notation "cuts" "*" simple_intropattern(H) ":" constr(E) := cuts H: E; [ auto_star | idtac ]. Tactic Notation "cuts" "*" ":" constr(E) := cuts: E; [ auto_star | idtac ]. Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E) := lets I: E; auto_star. Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0) constr(A1) := lets I: E0 A1; auto_star. Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) := lets I: E0 A1 A2; auto_star. Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) := lets I: E0 A1 A2 A3; auto_star. Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := lets I: E0 A1 A2 A3 A4; auto_star. Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets I: E0 A1 A2 A3 A4 A5; auto_star. Tactic Notation "lets" "*" ":" constr(E) := lets: E; auto_star. Tactic Notation "lets" "*" ":" constr(E0) constr(A1) := lets: E0 A1; auto_star. Tactic Notation "lets" "*" ":" constr(E0) constr(A1) constr(A2) := lets: E0 A1 A2; auto_star. Tactic Notation "lets" "*" ":" constr(E0) constr(A1) constr(A2) constr(A3) := lets: E0 A1 A2 A3; auto_star. Tactic Notation "lets" "*" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := lets: E0 A1 A2 A3 A4; auto_star. Tactic Notation "lets" "*" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets: E0 A1 A2 A3 A4 A5; auto_star. Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E) := forwards I: E; auto_star. Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0) constr(A1) := forwards I: E0 A1; auto_star. Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) := forwards I: E0 A1 A2; auto_star. Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) := forwards I: E0 A1 A2 A3; auto_star. Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := forwards I: E0 A1 A2 A3 A4; auto_star. Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := forwards I: E0 A1 A2 A3 A4 A5; auto_star. Tactic Notation "forwards" "*" ":" constr(E) := forwards: E; auto_star. Tactic Notation "forwards" "*" ":" constr(E0) constr(A1) := forwards: E0 A1; auto_star. Tactic Notation "forwards" "*" ":" constr(E0) constr(A1) constr(A2) := forwards: E0 A1 A2; auto_star. Tactic Notation "forwards" "*" ":" constr(E0) constr(A1) constr(A2) constr(A3) := forwards: E0 A1 A2 A3; auto_star. Tactic Notation "forwards" "*" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := forwards: E0 A1 A2 A3 A4; auto_star. Tactic Notation "forwards" "*" ":" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := forwards: E0 A1 A2 A3 A4 A5; auto_star. Tactic Notation "applys" "*" constr(H) := sapply H; auto_star. (*todo?*) Tactic Notation "applys" "*" constr(E0) constr(A1) := applys E0 A1; auto_star. Tactic Notation "applys" "*" constr(E0) constr(A1) := applys E0 A1; auto_star. Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) := applys E0 A1 A2; auto_star. Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) constr(A3) := applys E0 A1 A2 A3; auto_star. Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) := applys E0 A1 A2 A3 A4; auto_star. Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := applys E0 A1 A2 A3 A4 A5; auto_star. Tactic Notation "specializes" "*" hyp(H) := specializes H; auto_star. Tactic Notation "specializes" "~" hyp(H) constr(A1) := specializes H A1; auto_star. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) := specializes H A1 A2; auto_star. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) := specializes H A1 A2 A3; auto_star. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) := specializes H A1 A2 A3 A4; auto_star. Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := specializes H A1 A2 A3 A4 A5; auto_star. Tactic Notation "fapply" "*" constr(E) := fapply E; auto_star. Tactic Notation "sapply" "*" constr(E) := sapply E; auto_star. Tactic Notation "logic" constr(E) := logic_base E ltac:(fun _ => auto_star). Tactic Notation "intros_all" "*" := intros_all; auto_star. Tactic Notation "unfolds" "*" := unfolds; auto_star. Tactic Notation "unfolds" "*" constr(F1) := unfolds F1; auto_star. Tactic Notation "unfolds" "*" constr(F1) "," constr(F2) := unfolds F1, F2; auto_star. Tactic Notation "unfolds" "*" constr(F1) "," constr(F2) "," constr(F3) := unfolds F1, F2, F3; auto_star. Tactic Notation "unfolds" "*" constr(F1) "," constr(F2) "," constr(F3) "," constr(F4) := unfolds F1, F2, F3, F4; auto_star. Tactic Notation "simple" "*" := simpl; auto_star. Tactic Notation "simple" "*" "in" hyp(H) := simpl in H; auto_star. Tactic Notation "simpls" "*" := simpls; auto_star. Tactic Notation "hnfs" "*" := hnfs; auto_star. Tactic Notation "hnfs" "*" "in" hyp(H) := hnf in H; auto_star. Tactic Notation "substs" "*" := substs; auto_star. Tactic Notation "intro_hyp" "*" hyp(H) := subst_hyp H; auto_star. Tactic Notation "intro_subst" "*" := intro_subst; auto_star. Tactic Notation "subst_eq" "*" constr(E) := subst_eq E; auto_star. Tactic Notation "rewrite" "*" constr(E) := rewrite E; auto_star. Tactic Notation "rewrite" "*" "<-" constr(E) := rewrite <- E; auto_star. Tactic Notation "rewrite" "*" constr(E) "in" hyp(H) := rewrite E in H; auto_star. Tactic Notation "rewrite" "*" "<-" constr(E) "in" hyp(H) := rewrite <- E in H; auto_star. Tactic Notation "rewrites" "*" constr(E) := rewrites E; auto_star. Tactic Notation "rewrites" "*" constr(E) "in" hyp(H):= rewrites E in H; auto_star. Tactic Notation "rewrites" "*" constr(E) "in" "*":= rewrites E in *; auto_star. Tactic Notation "rewrites" "*" "<-" constr(E) := rewrites <- E; auto_star. Tactic Notation "rewrites" "*" "<-" constr(E) "in" hyp(H):= rewrites <- E in H; auto_star. Tactic Notation "rewrites" "*" "<-" constr(E) "in" "*":= rewrites <- E in *; auto_star. Tactic Notation "rewrite_all" "*" constr(E) := rewrite_all E; auto_star. Tactic Notation "rewrite_all" "*" "<-" constr(E) := rewrite_all <- E; auto_star. Tactic Notation "rewrite_all" "*" constr(E) "in" ident(H) := rewrite_all E in H; auto_star. Tactic Notation "rewrite_all" "*" "<-" constr(E) "in" ident(H) := rewrite_all <- E in H; auto_star. Tactic Notation "rewrite_all" "*" constr(E) "in" "*" := rewrite_all E in *; auto_star. Tactic Notation "rewrite_all" "*" "<-" constr(E) "in" "*" := rewrite_all <- E in *; auto_star. Tactic Notation "asserts_rewrite" "*" constr(E) := asserts_rewrite E; auto_star. Tactic Notation "asserts_rewrite" "*" "<-" constr(E) := asserts_rewrite <- E; auto_star. Tactic Notation "asserts_rewrite" "*" constr(E) "in" hyp(H) := asserts_rewrite E; auto_star. Tactic Notation "asserts_rewrite" "*" "<-" constr(E) "in" hyp(H) := asserts_rewrite <- E; auto_star. Tactic Notation "asserts_rewrite" "*" constr(E) "in" "*" := asserts_rewrite E in *; auto_tilde. Tactic Notation "asserts_rewrite" "*" "<-" constr(E) "in" "*" := asserts_rewrite <- E in *; auto_tilde. Tactic Notation "cuts_rewrite" "*" constr(E) := cuts_rewrite E; auto_star. Tactic Notation "cuts_rewrite" "*" "<-" constr(E) := cuts_rewrite <- E; auto_star. Tactic Notation "cuts_rewrite" "*" constr(E) "in" hyp(H) := cuts_rewrite E in H; auto_star. Tactic Notation "cuts_rewrite" "*" "<-" constr(E) "in" hyp(H) := cuts_rewrite <- E in H; auto_star. Tactic Notation "erewrite" "*" constr(E) := erewrite E; auto_star. Tactic Notation "fequal" "*" := fequal; auto_star. Tactic Notation "fequals" "*" := fequals; auto_star. Tactic Notation "pi_rewrite" "*" constr(E) := pi_rewrite E; auto_star. Tactic Notation "pi_rewrite" "*" constr(E) "in" hyp(H) := pi_rewrite E in H; auto_star. Tactic Notation "invert" "*" hyp(H) := invert H; auto_star. Tactic Notation "inverts" "*" hyp(H) := inverts H; auto_star. Tactic Notation "inverts" "*" hyp(E) "as" := inverts E as; auto_star. Tactic Notation "injects" "*" hyp(H) := injects H; auto_star. Tactic Notation "inversions" "*" hyp(H) := inversions H; auto_star. Tactic Notation "cases" "*" constr(E) "as" ident(H) := cases E as H; auto_star. Tactic Notation "cases" "*" constr(E) := cases E; auto_star. Tactic Notation "case_if" "*" := case_if; auto_star. Tactic Notation "case_ifs" "*" := case_ifs; auto_star. Tactic Notation "case_if" "*" "in" hyp(H) := case_if in H; auto_star. Tactic Notation "cases_if" "*" := cases_if; auto_star. Tactic Notation "cases_if" "*" "in" hyp(H) := cases_if in H; auto_star. Tactic Notation "destruct_if" "*" := destruct_if; auto_star. Tactic Notation "destruct_if" "*" "in" hyp(H) := destruct_if in H; auto_star. Tactic Notation "destruct_head_match" "*" := destruct_head_match; auto_star. Tactic Notation "cases'" "*" constr(E) "as" ident(H) := cases' E as H; auto_star. Tactic Notation "cases'" "*" constr(E) := cases' E; auto_star. Tactic Notation "cases_if'" "*" "as" ident(H) := cases_if' as H; auto_star. Tactic Notation "cases_if'" "*" := cases_if'; auto_star. Tactic Notation "decides_equality" "*" := decides_equality; auto_star. Tactic Notation "iff" "*" := iff; auto_star. Tactic Notation "iff" "*" simple_intropattern(I) := iff I; auto_star. Tactic Notation "splits" "*" := splits; auto_star. Tactic Notation "splits" "*" constr(N) := splits N; auto_star. Tactic Notation "destructs" "*" constr(T) := destructs T; auto_star. Tactic Notation "destructs" "*" constr(N) constr(T) := destructs N T; auto_star. Tactic Notation "branch" "*" constr(N) := branch N; auto_star. Tactic Notation "branch" "*" constr(K) "of" constr(N) := branch K of N; auto_star. Tactic Notation "branches" "*" constr(T) := branches T; auto_star. Tactic Notation "branches" "*" constr(N) constr(T) := branches N T; auto_star. Tactic Notation "exists" "*" := exists; auto_star. Tactic Notation "exists___" "*" := exists___; auto_star. Tactic Notation "exists" "*" constr(T1) := exists T1; auto_star. Tactic Notation "exists" "*" constr(T1) constr(T2) := exists T1 T2; auto_star. Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) := exists T1 T2 T3; auto_star. Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4) := exists T1 T2 T3 T4; auto_star. Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) := exists T1 T2 T3 T4 T5; auto_star. Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) constr(T6) := exists T1 T2 T3 T4 T5 T6; auto_star. Tactic Notation "exists" "*" constr(T1) "," constr(T2) := exists T1 T2; auto_star. Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) := exists T1 T2 T3; auto_star. Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) := exists T1 T2 T3 T4; auto_star. Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) "," constr(T5) := exists T1 T2 T3 T4 T5; auto_star. Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) "," constr(T5) "," constr(T6) := exists T1 T2 T3 T4 T5 T6; auto_star. (* ********************************************************************** *) (** * Tactics to sort out the proof context *) (* ---------------------------------------------------------------------- *) (** ** Hiding hypotheses *) (* Implementation *) Definition ltac_something (P:Type) (e:P) := e. Notation "'Something'" := (@ltac_something _ _). Lemma ltac_something_eq : forall (e:Type), e = (@ltac_something _ e). Proof using. auto. Qed. Lemma ltac_something_hide : forall (e:Type), e -> (@ltac_something _ e). Proof using. auto. Qed. Lemma ltac_something_show : forall (e:Type), (@ltac_something _ e) -> e. Proof using. auto. Qed. (** [hide_def x] and [show_def x] can be used to hide/show the body of the definition [x]. *) Tactic Notation "hide_def" hyp(x) := let x' := constr:(x) in let T := eval unfold x in x' in change T with (@ltac_something _ T) in x. Tactic Notation "show_def" hyp(x) := let x' := constr:(x) in let U := eval unfold x in x' in match U with @ltac_something _ ?T => change U with T in x end. (** [show_def] unfolds [Something] in the goal *) Tactic Notation "show_def" := unfold ltac_something. Tactic Notation "show_def" "in" hyp(H) := unfold ltac_something in H. Tactic Notation "show_def" "in" "*" := unfold ltac_something in *. (** [hide_defs] and [show_defs] applies to all definitions *) Tactic Notation "hide_defs" := repeat match goal with H := ?T |- _ => match T with | @ltac_something _ _ => fail 1 | _ => change T with (@ltac_something _ T) in H end end. Tactic Notation "show_defs" := repeat match goal with H := (@ltac_something _ ?T) |- _ => change (@ltac_something _ T) with T in H end. (** [hide_hyp H] replaces the type of [H] with the notation [Something] and [show_hyp H] reveals the type of the hypothesis. Note that the hidden type of [H] remains convertible the real type of [H]. *) Tactic Notation "show_hyp" hyp(H) := apply ltac_something_show in H. Tactic Notation "hide_hyp" hyp(H) := apply ltac_something_hide in H. (** [hide_hyps] and [show_hyps] can be used to hide/show all hypotheses of type [Prop]. *) Tactic Notation "show_hyps" := repeat match goal with H: @ltac_something _ _ |- _ => show_hyp H end. Tactic Notation "hide_hyps" := repeat match goal with H: ?T |- _ => match type of T with | Prop => match T with | @ltac_something _ _ => fail 2 | _ => hide_hyp H end | _ => fail 1 end end. (** [hide H] and [show H] automatically select between [hide_hyp] or [hide_def], and [show_hyp] or [show_def]. Similarly [hide_all] and [show_all] apply to all. *) Tactic Notation "hide" hyp(H) := first [hide_def H | hide_hyp H]. Tactic Notation "show" hyp(H) := first [show_def H | show_hyp H]. Tactic Notation "hide_all" := hide_hyps; hide_defs. Tactic Notation "show_all" := unfold ltac_something in *. (** [hide_term E] can be used to hide a term from the goal. [show_term] or [show_term E] can be used to reveal it. [hide_term E in H] can be used to specify an hypothesis. *) Tactic Notation "hide_term" constr(E) := change E with (@ltac_something _ E). Tactic Notation "show_term" constr(E) := change (@ltac_something _ E) with E. Tactic Notation "show_term" := unfold ltac_something. Tactic Notation "hide_term" constr(E) "in" hyp(H) := change E with (@ltac_something _ E) in H. Tactic Notation "show_term" constr(E) "in" hyp(H) := change (@ltac_something _ E) with E in H. Tactic Notation "show_term" "in" hyp(H) := unfold ltac_something in H. (** [show_unfold R] unfolds the definition of [R] and reveals the hidden definition of R. --todo:test, and implement using unfold simply *) (* --TODO: change "unfolds" *) Tactic Notation "show_unfold" constr(R1) := unfold R1; show_def. Tactic Notation "show_unfold" constr(R1) "," constr(R2) := unfold R1, R2; show_def. (* ---------------------------------------------------------------------- *) (** ** Sorting hypotheses *) (** [sort] sorts out hypotheses from the context by moving all the propositions (hypotheses of type Prop) to the bottom of the context. *) Ltac sort_tactic := try match goal with H: ?T |- _ => match type of T with Prop => generalizes H; (try sort_tactic); intro end end. Tactic Notation "sort" := sort_tactic. (* ---------------------------------------------------------------------- *) (** ** Clearing hypotheses *) (** [clears X1 ... XN] is a variation on [clear] which clears the variables [X1]..[XN] as well as all the hypotheses which depend on them. Contrary to [clear], it never fails. *) Tactic Notation "clears" ident(X1) := let rec doit _ := match goal with | H:context[X1] |- _ => clear H; try (doit tt) | _ => clear X1 end in doit tt. Tactic Notation "clears" ident(X1) ident(X2) := clears X1; clears X2. Tactic Notation "clears" ident(X1) ident(X2) ident(X3) := clears X1; clears X2; clears X3. Tactic Notation "clears" ident(X1) ident(X2) ident(X3) ident(X4) := clears X1; clears X2; clears X3; clears X4. Tactic Notation "clears" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) := clears X1; clears X2; clears X3; clears X4; clears X5. Tactic Notation "clears" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) ident(X6) := clears X1; clears X2; clears X3; clears X4; clears X5; clears X6. (** [clears] (without any argument) clears all the unused variables from the context. In other words, it removes any variable which is not a proposition (i.e. not of type Prop) and which does not appear in another hypothesis nor in the goal. *) (* --TODO: rename to clears_var ? *) Ltac clears_tactic := match goal with H: ?T |- _ => match type of T with | Prop => generalizes H; (try clears_tactic); intro | ?TT => clear H; (try clears_tactic) | ?TT => generalizes H; (try clears_tactic); intro end end. Tactic Notation "clears" := clears_tactic. (** [clears_all] clears all the hypotheses from the context that can be cleared. It leaves only the hypotheses that are mentioned in the goal. *) Ltac clears_or_generalizes_all_core := repeat match goal with H: _ |- _ => first [ clear H | generalizes H] end. Tactic Notation "clears_all" := generalize ltac_mark; clears_or_generalizes_all_core; intro_until_mark. (** [clears_but H1 H2 .. HN] clears all hypotheses except the one that are mentioned and those that cannot be cleared. *) Ltac clears_but_core cont := generalize ltac_mark; cont tt; clears_or_generalizes_all_core; intro_until_mark. Tactic Notation "clears_but" := clears_but_core ltac:(fun _ => idtac). Tactic Notation "clears_but" ident(H1) := clears_but_core ltac:(fun _ => gen H1). Tactic Notation "clears_but" ident(H1) ident(H2) := clears_but_core ltac:(fun _ => gen H1 H2). Tactic Notation "clears_but" ident(H1) ident(H2) ident(H3) := clears_but_core ltac:(fun _ => gen H1 H2 H3). Tactic Notation "clears_but" ident(H1) ident(H2) ident(H3) ident(H4) := clears_but_core ltac:(fun _ => gen H1 H2 H3 H4). Tactic Notation "clears_but" ident(H1) ident(H2) ident(H3) ident(H4) ident(H5) := clears_but_core ltac:(fun _ => gen H1 H2 H3 H4 H5). Lemma demo_clears_all_and_clears_but : forall x y:nat, y < 2 -> x = x -> x >= 2 -> x < 3 -> True. Proof using. introv M1 M2 M3. dup 6. (* [clears_all] clears all hypotheses. *) clears_all. auto. (* [clears_but H] clears all but [H] *) clears_but M3. auto. clears_but y. auto. clears_but x. auto. clears_but M2 M3. auto. clears_but x y. auto. Qed. (** [clears_last] clears the last hypothesis in the context. [clears_last N] clears the last [N] hypotheses in the context. *) Tactic Notation "clears_last" := match goal with H: ?T |- _ => clear H end. Ltac clears_last_base N := match number_to_nat N with | 0 => idtac | S ?p => clears_last; clears_last_base p end. Tactic Notation "clears_last" constr(N) := clears_last_base N. (* ********************************************************************** *) (** * Tactics for development purposes *) (* ---------------------------------------------------------------------- *) (** ** Skipping subgoals *) (** The [skip] tactic can be used at any time to admit the current goal. Unlike [admit], it does not require ending the proof with [Admitted] instead of [Qed]. It thus saves the pain of renaming [Qed] into [Admitted] and vice-versa all the time. The implementation of [skip] relies on an axiom [False]. To obtain a safe development, it suffices to replace [False] with [True] in the statement of that axiom. Note that it is still necessary to instantiate all the existential variables introduced by other tactics in order for [Qed] to be accepted. *) (** To obtain a safe development, change to [skip_axiom : True] *) Axiom skip_axiom : False. Ltac skip_with_axiom := exfalso; apply skip_axiom. Tactic Notation "skip" := skip_with_axiom. (** To use traditional [admit] instead of [skip] in the tactics defined below, uncomment the following definition, to bind [skip] to [admit]. *) (* Tactic Notation "skip" := admit. *) (** [demo] is like [admit] but it documents the fact that admit is intended *) Tactic Notation "demo" := skip. (** [admits H: T] adds an assumption named [H] of type [T] to the current context, blindly assuming that it is true. [admit: T] is another possible syntax. Note that H may be an intro pattern. *) Tactic Notation "admits" simple_intropattern(I) ":" constr(T) := asserts I: T; [ skip | ]. Tactic Notation "admits" ":" constr(T) := let H := fresh "TEMP" in admits H: T. Tactic Notation "admits" "~" ":" constr(T) := admits: T; auto_tilde. Tactic Notation "admits" "*" ":" constr(T) := admits: T; auto_star. (** [admit_cuts T] simply replaces the current goal with [T]. *) Tactic Notation "admit_cuts" constr(T) := cuts: T; [ skip | ]. (** [admit_goal H] applies to any goal. It simply assumes the current goal to be true. The assumption is named "H". It is useful to set up proof by induction or coinduction. Syntax [admit_goal] is also accepted.*) Tactic Notation "admit_goal" ident(H) := match goal with |- ?G => admits H: G end. Tactic Notation "admit_goal" := let IH := fresh "IH" in admit_goal IH. (** [admit_rewrite T] can be applied when [T] is an equality. It blindly assumes this equality to be true, and rewrite it in the goal. *) Tactic Notation "admit_rewrite" constr(T) := let M := fresh "TEMP" in admits M: T; rewrite M; clear M. (** [admit_rewrite T in H] is similar as [admit_rewrite], except that it rewrites in hypothesis [H]. *) Tactic Notation "admit_rewrite" constr(T) "in" hyp(H) := let M := fresh "TEMP" in admits M: T; rewrite M in H; clear M. (** [admit_rewrites_all T] is similar as [admit_rewrite], except that it rewrites everywhere (goal and all hypotheses). *) Tactic Notation "admit_rewrite_all" constr(T) := let M := fresh "TEMP" in admits M: T; rewrite_all M; clear M. (** [forwards_nounfold_admit_sides_then E ltac:(fun K => ..)] is like [forwards: E] but it provides the resulting term to a continuation, under the name [K], and it admits any side-condition produced by the instantiation of [E], using the [skip] tactic. *) Inductive ltac_goal_to_discard := ltac_goal_to_discard_intro. Ltac forwards_nounfold_admit_sides_then S cont := let MARK := fresh "TEMP" in generalize ltac_goal_to_discard_intro; intro MARK; forwards_nounfold_then S ltac:(fun K => clear MARK; cont K); match goal with | MARK: ltac_goal_to_discard |- _ => skip | _ => idtac end. (** DEPRECATED -- FOR BACKWARD COMPATIBILITY *) Tactic Notation "skip" simple_intropattern(I) ":" constr(T) := admits I: T. Tactic Notation "skip" ":" constr(T) := admits: T. Tactic Notation "skip" "~" ":" constr(T) := admits~:T. Tactic Notation "skip" "*" ":" constr(T) := admits*:T. Tactic Notation "skip" simple_intropattern(I1) simple_intropattern(I2) ":" constr(T) := skip [I1 I2]: T. Tactic Notation "skip" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) := skip [I1 [I2 I3]]: T. Tactic Notation "skip" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) ":" constr(T) := skip [I1 [I2 [I3 I4]]]: T. Tactic Notation "skip" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) := skip [I1 [I2 [I3 [I4 I5]]]]: T. Tactic Notation "skip" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) ":" constr(T) := skip [I1 [I2 [I3 [I4 [I5 I6]]]]]: T. Tactic Notation "skip_asserts" simple_intropattern(I) ":" constr(T) := admits I: T. Tactic Notation "skip_asserts" ":" constr(T) := admits: T. Tactic Notation "skip_cuts" constr(T) := admit_cuts T. Tactic Notation "skip_goal" ident(H) := admit_goal H. Tactic Notation "skip_goal" := admit_goal. Tactic Notation "skip_rewrite" constr(T) := admit_rewrite T. Tactic Notation "skip_rewrite" constr(T) "in" hyp(H) := admit_rewrite T in H. Tactic Notation "skip_rewrite_all" constr(T) := admit_rewrite_all T. Ltac forwards_nounfold_skip_sides_then S cont := forwards_nounfold_admit_sides_then S cont. Tactic Notation "skip_induction" constr(E) := let IH := fresh "IH" in admit_goal IH; destruct E. Tactic Notation "skip_induction" constr(E) "as" simple_intropattern(I) := let IH := fresh "IH" in admit_goal IH; destruct E as I. (* ********************************************************************** *) (** * Compatibility with standard library *) (** The module [Program] contains definitions that conflict with the current module. If you import [Program], either directly or indirectly (e.g. through [Setoid] or [ZArith]), you will need to import the compability definitions through the top-level command: [Import LibTacticsCompatibility]. *) Module LibTacticsCompatibility. Tactic Notation "apply" "*" constr(H) := sapply H; auto_star. Tactic Notation "subst" "*" := subst; auto_star. End LibTacticsCompatibility. Open Scope nat_scope. (* ********************************************************************** *) (** * Additional notations for Coq *) (* ---------------------------------------------------------------------- *) (** ** N-ary Existentials --TODO: DEPRECATED, Coq now supports it. *) (** [exists T1 ... TN, P] is a shorthand for [exists T1, ..., exists TN, P]. Note that [Coq.Program.Syntax] already defines exists for arity up to 4. *) Notation "'exists' x1 ',' P" := (exists x1, P) (at level 200, x1 ident, right associativity) : type_scope. Notation "'exists' x1 x2 ',' P" := (exists x1, exists x2, P) (at level 200, x1 ident, x2 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 ',' P" := (exists x1, exists x2, exists x3, P) (at level 200, x1 ident, x2 ident, x3 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 x4 ',' P" := (exists x1, exists x2, exists x3, exists x4, P) (at level 200, x1 ident, x2 ident, x3 ident, x4 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 x4 x5 ',' P" := (exists x1, exists x2, exists x3, exists x4, exists x5, P) (at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 x4 x5 x6 ',' P" := (exists x1, exists x2, exists x3, exists x4, exists x5, exists x6, P) (at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident, x6 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 x4 x5 x6 x7 ',' P" := (exists x1, exists x2, exists x3, exists x4, exists x5, exists x6, exists x7, P) (at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident, x6 ident, x7 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 x4 x5 x6 x7 x8 ',' P" := (exists x1, exists x2, exists x3, exists x4, exists x5, exists x6, exists x7, exists x8, P) (at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident, x6 ident, x7 ident, x8 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 x4 x5 x6 x7 x8 x9 ',' P" := (exists x1, exists x2, exists x3, exists x4, exists x5, exists x6, exists x7, exists x8, exists x9, P) (at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident, x6 ident, x7 ident, x8 ident, x9 ident, right associativity) : type_scope. Notation "'exists' x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ',' P" := (exists x1, exists x2, exists x3, exists x4, exists x5, exists x6, exists x7, exists x8, exists x9, exists x10, P) (at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident, x6 ident, x7 ident, x8 ident, x9 ident, x10 ident, right associativity) : type_scope. (* ---------------------------------------------------------------------- *) (** ** ['let] bindings (EXPERIMENTAL). *) (** The syntax ['let x := v in e] has the same meaning as [let x := v in e] except that the binding is implemented using a beta-redex that is not reduced automatically by [simpl]. The ['let] construct therefore makes it possible to simplify or push to the context let-bindings one by one. *) (** Definition of ['let] *) Definition let_binding (A B:Type) (v:A) (K:A->B) := K v. Notation "''let' x ':=' v 'in' e" := (let_binding v (fun x => e)) (at level 69, x ident, right associativity, format "'[v' '[' ''let' x ':=' v 'in' ']' '/' '[' e ']' ']'") : let_scope. Notation "''let' x ':' A ':=' v 'in' e" := (let_binding (v:A) (fun x:A => e)) (at level 69, x ident, right associativity, format "'[v' '[' ''let' x ':' A ':=' v 'in' ']' '/' '[' e ']' ']'") : let_scope. Global Open Scope let_scope. Lemma let_binding_unfold : forall (A B:Type) (v:A) (K:A->B), let_binding v K = K v. Proof using. reflexivity. Qed. Ltac let_get_fresh_binding_name K := match K with (fun x => _) => let y := fresh x in y end. (** [let_simpl] finds the first occurence of a ['let] binding and substitutes it. *) Tactic Notation "let_simpl" "in" hyp(H) := match type of H with context [ let_binding ?v ?K ] => changes (let_binding v K) with (K v) in H end. Tactic Notation "let_simpl" := match goal with | |- context [ let_binding ?v ?K ] => changes (let_binding v K) with (K v) | H: context [ let_binding ?v ?K ] |- _ => let_simpl in H end. Tactic Notation "let_simpl" constr(v) "in" hyp(H) := repeat match type of H with context [ let_binding v ?K ] => changes (let_binding v K) with (K v) in H end. Tactic Notation "let_simpl" constr(v) := repeat match goal with | |- context [ let_binding v ?K ] => changes (let_binding v K) with (K v) | H: context [ let_binding v ?K ] |- _ => let_simpl v in H end. (** [let_name] finds the first occurence of a ['let] binding and moves this binding to the proof context. *) Tactic Notation "let_name" "in" hyp(H) := match type of H with context [ let_binding ?v ?K ] => let x := let_get_fresh_binding_name K in set_eq x: v in H; let_simpl in H end. Tactic Notation "let_name" "in" hyp(H) "as" ident(x) := match type of H with context [ let_binding ?v ?K ] => set_eq x: v in H; let_simpl in H end. Tactic Notation "let_name" := match goal with | |- context [ let_binding ?v ?K ] => let x := let_get_fresh_binding_name K in set_eq x: v; let_simpl | H: context [ let_binding ?v ?K ] |- _ => let_name in H end. Tactic Notation "let_name" "as" ident(x) := match goal with | |- context [ let_binding ?v ?K ] => set_eq x: v; let_simpl | H: context [ let_binding ?v ?K ] |- _ => let_name in H as x end. (** [let_name_all] finds the first occurence of a ['let] binding, moves this binding to the proof context, and further simplify all the other ['let] bindings that are binding the same value. (See LibFixDemos for a practical motivation.) *) Tactic Notation "let_name_all" "in" hyp(H) := match type of H with context [ let_binding ?v ?K ] => let x := let_get_fresh_binding_name K in set_eq x: v in H; let_simpl x in H end. Tactic Notation "let_name_all" "in" hyp(H) "as" ident(x) := match type of H with context [ let_binding ?v ?K ] => set_eq x: v in H; let_simpl x in H end. Tactic Notation "let_name_all" := match goal with | |- context [ let_binding ?v ?K ] => let x := let_get_fresh_binding_name K in set_eq x: v; let_simpl x | H: context [ let_binding ?v ?K ] |- _ => let_name_all in H end. Tactic Notation "let_name_all" "as" ident(x) := match goal with | |- context [ let_binding ?v ?K ] => set_eq x: v; let_simpl x | H: context [ let_binding ?v ?K ] |- _ => let_name_all in H as x end. (* ---------------------------------------------------------------------- *) (* Bugfix for [f_equal] and [fequals]; only supports up to arity 5 *) Section FuncEq. Variables (A1 A2 A3 A4 A5 B : Type). Lemma args_eq_1 : forall (f:A1->B) x1 y1, x1 = y1 -> f x1 = f y1. Proof using. intros. subst~. Qed. Lemma args_eq_2 : forall (f:A1->A2->B) x1 y1 x2 y2, x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2. Proof using. intros. subst~. Qed. Lemma args_eq_3 : forall (f:A1->A2->A3->B) x1 y1 x2 y2 x3 y3, x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3. Proof using. intros. subst~. Qed. Lemma args_eq_4 : forall (f:A1->A2->A3->A4->B) x1 y1 x2 y2 x3 y3 x4 y4, x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4. Proof using. intros. subst~. Qed. Lemma args_eq_5 : forall (f:A1->A2->A3->A4->A5->B) x1 y1 x2 y2 x3 y3 x4 y4 x5 y5, x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5. Proof using. intros. subst~. Qed. End FuncEq. Ltac f_equal_fixed := try ( first [ apply args_eq_1 | apply args_eq_2 | apply args_eq_3 | apply args_eq_4 | apply args_eq_5 ]; try reflexivity). Ltac fequal_base ::= let go := f_equal_fixed; [ fequal_base | ] in match goal with | |- (_,_,_) = (_,_,_) => go | |- (_,_,_,_) = (_,_,_,_) => go | |- (_,_,_,_,_) = (_,_,_,_,_) => go | |- (_,_,_,_,_,_) = (_,_,_,_,_,_) => go | |- _ => f_equal_fixed end. (* ---------------------------------------------------------------------- *) (* Bugfix for [autorewrite in *], which is currently inefficient *) (** Generalize all propositions into the goal. Naive implementation: Ltac generalize_all_prop := repeat match goal with H: ?T |- _ => match type of T with Prop => generalizes H end end. The real implementation is careful to not generalized [ltac_Mark], even though it is of type [Prop]. TODO: investigate whether it would be sufficient to put [ltac_Mark] in [Type] to obtain the desired behavior. *) Ltac generalize_all_prop := repeat match goal with H: ?T |- _ => try match T with ltac_Mark => fail 2 end; match type of T with Prop => generalizes H end end. (** Work around for inefficiency bug of [autorewrite in *]. Usage, e.g.: [Tactic Notation "rew_list" "in" "*" := autorewrite_in_star_patch ltac:(fun tt => autorewrite with rew_list)]. *) Ltac autorewrite_in_star_patch cont := generalize ltac_mark; generalize_all_prop; cont tt; intro_until_mark. coq-serapi-8.20.0-0.20.0/tests/genarg/ltac2.v000066400000000000000000000001141466734233400201700ustar00rootroot00000000000000From Ltac2 Require Import Ltac2. Goal True /\ True. split; exact I. Qed. coq-serapi-8.20.0-0.20.0/tests/genarg/mbid.v000066400000000000000000000032321466734233400201020ustar00rootroot00000000000000(* Test file for #150, provided by Clement Pit-Claudel. Note that the problem here is with serialization of Goals, not AST. *) Require Export NumPrelude NZAxioms. Require Import NZBase NZOrder NZAddOrder. (** In this file, we investigate the shape of domains satisfying the [NZDomainSig] interface. In particular, we define a translation from Peano numbers [nat] into NZ. *) Local Notation "f ^ n" := (fun x => nat_rect _ x (fun _ => f) n). #[global] Instance nat_rect_wd n {A} (R:relation A) : Proper (R==>(R==>R)==>R) (fun x f => nat_rect (fun _ => _) x (fun _ => f) n). Proof. intros x y eq_xy f g eq_fg; induction n; [assumption | now apply eq_fg]. Qed. Module NZDomainProp (Import NZ:NZDomainSig'). Include NZBaseProp NZ. (** * Relationship between points thanks to [succ] and [pred]. *) (** For any two points, one is an iterated successor of the other. *) Lemma itersucc_or_itersucc n m : exists k, n == (S^k) m \/ m == (S^k) n. Proof. revert n. apply central_induction with (z:=m). { intros x y eq_xy; apply ex_iff_morphism. intros n; apply or_iff_morphism. + split; intros; etransitivity; try eassumption; now symmetry. + split; intros; (etransitivity; [eassumption|]); [|symmetry]; (eapply nat_rect_wd; [eassumption|apply succ_wd]). } exists 0%nat. now left. intros n. split; intros [k [L|R]]. exists (Datatypes.S k). left. now apply succ_wd. destruct k as [|k]. simpl in R. exists 1%nat. left. now apply succ_wd. rewrite nat_rect_succ_r in R. exists k. now right. destruct k as [|k]; simpl in L. exists 1%nat. now right. apply succ_inj in L. exists k. now left. exists (Datatypes.S k). right. now rewrite nat_rect_succ_r. Qed. End NZDomainProp. coq-serapi-8.20.0-0.20.0/tests/genarg/move.v000066400000000000000000000045341466734233400201430ustar00rootroot00000000000000From Coq Require Import ssreflect ssrbool ssrfun. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Module Equality. Definition axiom T (e : rel T) := forall x y, reflect (x = y) (e x y). Structure mixin_of T := Mixin {op : rel T; _ : axiom op}. Notation class_of := mixin_of (only parsing). Section ClassDef. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (cT : type). Definition class := let: @Pack _ c := cT return class_of cT in c. Definition clone := fun c & cT -> T & phant_id (@Pack T c) cT => Pack c. End ClassDef. Definition eqType := Equality.type. Coercion Equality.sort : Equality.type >-> Sortclass. Notation EqType T m := (@Equality.Pack T m). Module Ordered. Section RawMixin. Structure mixin_of (T : eqType) := Mixin {ordering : rel T; _ : irreflexive ordering; _ : transitive ordering; }. End RawMixin. Section ClassDef. Record class_of (T : Type) := Class { base : Equality.class_of T; mixin : mixin_of (Equality.Pack base)}. Local Coercion base : class_of >-> Equality.class_of. Structure type : Type := Pack {sort : Type; _ : class_of sort;}. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (cT : type). Definition class := let: @Pack _ c as cT' := cT return class_of cT' in c. Definition pack b (m0 : mixin_of (EqType T b)) := fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := Equality.Pack class. End ClassDef. Module Exports. Coercion eqType : type >-> Equality.type. Canonical Structure eqType. Notation ordType := Ordered.type. Definition ord T : rel (sort T) := (ordering (mixin (class T))). End Exports. End Ordered. Export Ordered.Exports. Definition eq_op T := Equality.op (Equality.class T). Notation "x == y" := (eq_op x y) (at level 70, no associativity) : bool_scope. Lemma eqP T : Equality.axiom (@eq_op T). Proof. by case: T => ? []. Qed. Arguments eqP {T x y}. Definition oleq (T : ordType) (t1 t2 : T) := ord t1 t2 || (t1 == t2). Prenex Implicits ord oleq. Section Lemmas. Variable T : ordType. Implicit Types x y : T. Variable trans : transitive (@ord T). Lemma otrans : transitive (@oleq T). Proof. move=>x y z /=. case/orP; last by move/eqP=>->. rewrite /oleq; move=>T1. case/orP; first by move/(trans T1)=>->. by move/eqP=><-; rewrite T1. Qed. End Lemmas. coq-serapi-8.20.0-0.20.0/tests/genarg/now.v000066400000000000000000000000701466734233400177670ustar00rootroot00000000000000Lemma addnC n : n + 0 = n. Proof. now induction n. Qed. coq-serapi-8.20.0-0.20.0/tests/genarg/primitives.v000066400000000000000000000003531466734233400213630ustar00rootroot00000000000000Require Export CarryType. Primitive int := #int63_type. Primitive lsl := #int63_lsl. Set Universe Polymorphism. Primitive array := #array_type. Primitive make : forall A, int -> A -> array A := #array_make. Arguments make {_} _ _. coq-serapi-8.20.0-0.20.0/tests/genarg/rename.v000066400000000000000000000002121466734233400204310ustar00rootroot00000000000000Require Import ZArith. Open Scope Z_scope. Lemma Zplus0 : forall n, n + 0 = n. Proof. intros n. rename n into m. auto with zarith. Qed. coq-serapi-8.20.0-0.20.0/tests/genarg/replace.v000066400000000000000000000034261466734233400206070ustar00rootroot00000000000000Require Import ZArith Zquot. Record radix := { radix_val :> Z ; radix_prop : Zle_bool 2 radix_val = true }. Theorem Zpower_plus : forall n k1 k2, (0 <= k1)%Z -> (0 <= k2)%Z -> Zpower n (k1 + k2) = (Zpower n k1 * Zpower n k2)%Z. Proof. intros n k1 k2 H1 H2. now apply Zpower_exp ; apply Z.le_ge. Qed. Theorem Zpower_Zpower_nat : forall b e, (0 <= e)%Z -> Zpower b e = Zpower_nat b (Z.abs_nat e). Proof. intros b [|e|e] He. apply refl_equal. apply Zpower_pos_nat. elim He. apply refl_equal. Qed. Theorem Zpower_nat_S : forall b e, Zpower_nat b (S e) = (b * Zpower_nat b e)%Z. Proof. intros b e. rewrite (Zpower_nat_is_exp 1 e). apply (f_equal (fun x => x * _)%Z). apply Zmult_1_r. Qed. Section Beta. Variable beta : radix. Theorem radix_gt_0 : (0 < beta)%Z. Proof. apply Z.lt_le_trans with 2%Z. easy. apply Zle_bool_imp_le. apply beta. Qed. Theorem Zpower_gt_0 : forall p, (0 <= p)%Z -> (0 < Zpower beta p)%Z. Proof. intros p Hp. rewrite Zpower_Zpower_nat with (1 := Hp). induction (Z.abs_nat p). easy. rewrite Zpower_nat_S. apply Zmult_lt_0_compat with (2 := IHn). apply radix_gt_0. Qed. Definition Zdigit n k := Z.rem (Z.quot n (Zpower beta k)) beta. Theorem Zdigit_ge_Zpower_pos : forall e n, (0 <= n < Zpower beta e)%Z -> forall k, (e <= k)%Z -> Zdigit n k = Z0. Proof. intros e n Hn k Hk. unfold Zdigit. rewrite Z.quot_small. apply Zrem_0_l. split. apply Hn. apply Z.lt_le_trans with (1 := proj2 Hn). replace k with (e + (k - e))%Z by ring. rewrite Zpower_plus. rewrite <- (Zmult_1_r (beta ^ e)) at 1. apply Zmult_le_compat_l. apply (Zlt_le_succ 0). apply Zpower_gt_0. now apply Zle_minus_le_0. apply Zlt_le_weak. now apply Z.le_lt_trans with n. generalize (Z.le_lt_trans _ _ _ (proj1 Hn) (proj2 Hn)). clear. now destruct e as [|e|e]. now apply Zle_minus_le_0. Qed. End Beta. coq-serapi-8.20.0-0.20.0/tests/genarg/revert.v000066400000000000000000000024221466734233400204760ustar00rootroot00000000000000Require Import List. Import ListNotations. Require Import Sumbool. Ltac break_and := repeat match goal with | [H : _ /\ _ |- _ ] => destruct H end. Ltac break_if := match goal with | [ |- context [ if ?X then _ else _ ] ] => match type of X with | sumbool _ _ => destruct X | _ => destruct X eqn:? end end. Definition update2 {A B : Type} (A_eq_dec : forall x y : A, {x = y} + {x <> y}) (f : A -> A -> B) (x y : A) (v : B) := fun x' y' => if sumbool_and _ _ _ _ (A_eq_dec x x') (A_eq_dec y y') then v else f x' y'. Fixpoint collate {A B : Type} (A_eq_dec : forall x y : A, {x = y} + {x <> y}) (from : A) (f : A -> A -> list B) (ms : list (A * B)) := match ms with | [] => f | (to, m) :: ms' => collate A_eq_dec from (update2 A_eq_dec f from to (f from to ++ [m])) ms' end. Section Update2. Variables A B : Type. Hypothesis A_eq_dec : forall x y : A, {x = y} + {x <> y}. Lemma collate_neq : forall h n n' ns (f : A -> A -> list B), h <> n -> collate A_eq_dec h f ns n n' = f n n'. Proof using. intros. revert f. induction ns; intros; auto. destruct a. simpl in *. rewrite IHns. unfold update2. break_if; auto. break_and; subst. intuition. Qed. End Update2.coq-serapi-8.20.0-0.20.0/tests/genarg/setoid_rewrite.v000066400000000000000000000007521466734233400222230ustar00rootroot00000000000000Require Setoid. Require Import PeanoNat Bool List. Require Import Lia. Section ReDun. Variable A : Type. Variable decA : forall (a b : A), {a = b}+{a <> b}. Theorem NoDup_count_occ' l: NoDup l <-> (forall x:A, In x l -> count_occ decA l x = 1). Proof. rewrite (NoDup_count_occ decA). setoid_rewrite (count_occ_In decA) at 1. unfold gt, lt in *. split; intros H x; specialize (H x); set (n := count_occ decA l x) in *; clearbody n; lia. Qed. End ReDun. coq-serapi-8.20.0-0.20.0/tests/genarg/specialize.v000066400000000000000000000023441466734233400213220ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Ltac break_match := match goal with | [ |- context [ match ?X with _ => _ end ] ] => match type of X with | sumbool _ _ => destruct X | _ => destruct X eqn:? end end. Ltac do_in_app := match goal with | [ H : In _ (_ ++ _) |- _ ] => apply in_app_iff in H end. Section dedup. Variable A : Type. Hypothesis A_eq_dec : forall x y : A, {x = y} + {x <> y}. Fixpoint dedup (xs : list A) : list A := match xs with | [] => [] | x :: xs => let tail := dedup xs in if in_dec A_eq_dec x xs then tail else x :: tail end. Lemma dedup_app : forall (xs ys : list A), (forall x y, In x xs -> In y ys -> x <> y) -> dedup (xs ++ ys) = dedup xs ++ dedup ys. Proof using. intros. induction xs; simpl; auto. repeat break_match. - apply IHxs. intros. apply H; intuition. - exfalso. specialize (H a a). apply H; intuition. do_in_app. intuition. - exfalso. apply n. intuition. - simpl. f_equal. apply IHxs. intros. apply H; intuition. Qed. End dedup.coq-serapi-8.20.0-0.20.0/tests/genarg/subst.v000066400000000000000000000042771466734233400203410ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Section assoc. Variable K V : Type. Variable K_eq_dec : forall k k' : K, {k = k'} + {k <> k'}. Fixpoint assoc (l : list (K * V)) (k : K) : option V := match l with | [] => None | (k', v) :: l' => if K_eq_dec k k' then Some v else assoc l' k end. Fixpoint assoc_set (l : list (K * V)) (k : K) (v : V) : list (K * V) := match l with | [] => [(k, v)] | (k', v') :: l' => if K_eq_dec k k' then (k, v) :: l' else (k', v') :: (assoc_set l' k v) end. Lemma get_set_same : forall k v l, assoc (assoc_set l k v) k = Some v. Proof using. induction l; intros; simpl. - destruct (K_eq_dec _ _); simpl; subst; congruence. - destruct a; repeat (destruct (K_eq_dec _ _); simpl; subst; try congruence). Qed. Lemma get_set_diff : forall k k' v l, k <> k' -> assoc (assoc_set l k v) k' = assoc l k'. Proof using. induction l; intros; simpl. - destruct (K_eq_dec _ _); simpl; subst; congruence. - destruct a. repeat (destruct (K_eq_dec _ _); simpl; subst; try congruence). rewrite IHl; auto. Qed. Ltac assoc_rewrite := match goal with | [ |- context [assoc (assoc_set _ ?k0' _) ?k0 ] ] => first [rewrite get_set_same with (k := k0) by auto | rewrite get_set_diff with (k' := k0) by auto ] end. Definition a_equiv (l1 : list (K * V)) l2 := forall k,assoc l1 k = assoc l2 k. Lemma assoc_set_assoc_set_diff : forall l (k : K) (v : V) k' v', k <> k' -> a_equiv (assoc_set (assoc_set l k v) k' v') (assoc_set (assoc_set l k' v') k v). Proof using. unfold a_equiv. intros. destruct (K_eq_dec k0 k'); [subst k'; rewrite get_set_same with (k := k0)| rewrite get_set_diff with (k' := k0) by auto]. - now repeat assoc_rewrite. - destruct (K_eq_dec k0 k); [subst k; rewrite get_set_same with (k := k0)| rewrite get_set_diff with (k' := k0) by auto]. + now repeat assoc_rewrite. + now repeat assoc_rewrite. Qed. End assoc.coq-serapi-8.20.0-0.20.0/tests/genarg/symmetry.v000066400000000000000000000004441466734233400210620ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Section list_util. Variables A : Type. Lemma list_neq_cons : forall (l : list A) x, x :: l <> l. Proof using. intuition. symmetry in H. induction l; now inversion H. Qed. End list_util. coq-serapi-8.20.0-0.20.0/tests/genarg/tactic_notation.v000066400000000000000000000011651466734233400223540ustar00rootroot00000000000000Require ZArith.BinInt. Definition ltac_int_to_nat (x:BinInt.Z) : nat := match x with | BinInt.Z0 => 0%nat | BinInt.Zpos p => BinPos.nat_of_P p | BinInt.Zneg p => 0%nat end. Ltac number_to_nat N := match type of N with | nat => constr:(N) | BinInt.Z => let N' := constr:(ltac_int_to_nat N) in eval compute in N' end. Lemma dup_lemma : forall P, P -> P -> P. Proof using. auto. Qed. Ltac dup_tactic N := match number_to_nat N with | 0 => idtac | S 0 => idtac | S ?N' => apply dup_lemma; [ | dup_tactic N' ] end. Tactic Notation "dup" constr(N) := dup_tactic N. Tactic Notation "dup" := dup 2. coq-serapi-8.20.0-0.20.0/tests/genarg/test_roundtrip.in000077500000000000000000000003461466734233400224230ustar00rootroot00000000000000#!/usr/bin/env bash set -e SERCOMP=../../sertop/sercomp.exe FILE_IN="$1" FILE_OUT="${FILE_IN%.v}.sexp" $SERCOMP --input=vernac --mode=sexp --exn_on_opaque "$FILE_IN" > "$FILE_OUT" $SERCOMP --input=sexp --mode=check "$FILE_OUT" coq-serapi-8.20.0-0.20.0/tests/quick/000077500000000000000000000000001466734233400166515ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/tests/quick/ab.v000066400000000000000000000001671466734233400174260ustar00rootroot00000000000000Section AB. Lemma a: True. Proof. idtac. fail. auto. Qed. Lemma b: True. Proof. pose proof a as H. auto. Qed. End AB. coq-serapi-8.20.0-0.20.0/tests/quick/assoc.v000066400000000000000000000043221466734233400201510ustar00rootroot00000000000000Require Import List. Import ListNotations. Set Implicit Arguments. Ltac break_match_hyp := match goal with | [ H : context [ match ?X with _ => _ end ] |- _] => match type of X with | sumbool _ _ => destruct X | _ => destruct X eqn:? end end. Ltac break_match_goal := match goal with | [ |- context [ match ?X with _ => _ end ] ] => match type of X with | sumbool _ _ => destruct X | _ => destruct X eqn:? end end. Ltac break_match := break_match_goal || break_match_hyp. Section assoc. Variable K V : Type. Variable K_eq_dec : forall k k' : K, {k = k'} + {k <> k'}. Fixpoint assoc (l : list (K * V)) (k : K) : option V := match l with | [] => None | (k', v) :: l' => if K_eq_dec k k' then Some v else assoc l' k end. Definition assoc_default (l : list (K * V)) (k : K) (default : V) : V := match (assoc l k) with | Some x => x | None => default end. Fixpoint assoc_set (l : list (K * V)) (k : K) (v : V) : list (K * V) := match l with | [] => [(k, v)] | (k', v') :: l' => if K_eq_dec k k' then (k, v) :: l' else (k', v') :: (assoc_set l' k v) end. Fixpoint assoc_del (l : list (K * V)) (k : K) : list (K * V) := match l with | [] => [] | (k', v') :: l' => if K_eq_dec k k' then assoc_del l' k else (assoc_del l' k) end. Lemma get_set_diff : forall k k' v l, k <> k' -> assoc (assoc_set l k v) k' = assoc l k'. Proof using. induction l; intros; simpl; repeat (break_match; simpl); subst; try congruence; auto. Qed. Lemma get_del_same : forall k l, assoc (assoc_del l k) k = None. Proof using. induction l; intros; simpl in *. - auto. - repeat break_match; subst; simpl in *; auto. break_if; try congruence. Qed. Lemma get_set_diff_default : forall (k k' : K) (v : V) l d, k <> k' -> assoc_default (assoc_set l k v) k' d = assoc_default l k' d. Proof using. unfold assoc_default. intros. repeat break_match; auto; rewrite get_set_diff in * by auto; congruence. Qed. End assoc. coq-serapi-8.20.0-0.20.0/tests/quick/dune000066400000000000000000000011511466734233400175250ustar00rootroot00000000000000(rule (alias runtest) (deps (package coq-serapi) (:input ab.v)) (action (ignore-outputs (bash "%{bin:sercomp} --quick %{input}")))) (rule (alias runtest) (deps (package coq-serapi) (:input assoc.v)) (action (ignore-outputs (bash "%{bin:sercomp} --quick %{input}")))) (rule (alias runtest) (deps (package coq-serapi) (:input ordered.v)) (action (ignore-outputs (bash "%{bin:sercomp} --quick %{input}")))) (rule (alias runtest) (deps (package coq-serapi) (:input reserved.v)) (action (ignore-outputs (bash "%{bin:sercomp} --quick %{input}")))) coq-serapi-8.20.0-0.20.0/tests/quick/ordered.v000066400000000000000000000023021466734233400204610ustar00rootroot00000000000000Require Import List. Require Import NArith. Module Type OrderedTypeAlt. Parameter t : Type. Parameter compare : t -> t -> comparison. Infix "?=" := compare (at level 70, no associativity). Parameter compare_sym : forall x y, (y?=x) = CompOpp (x?=y). Parameter compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. Parameter reflect : forall x y, x ?= y = Eq -> x = y. End OrderedTypeAlt. Module Nat_as_OTA <: OrderedTypeAlt. Definition t := nat. Fixpoint compare x y := match x,y with | O,O => Eq | O,_ => Lt | _,O => Gt | S x, S y => compare x y end. Lemma compare_sym: forall x y, compare y x = CompOpp (compare x y). Proof using. induction x; intros y; destruct y; simpl; auto. Qed. Lemma compare_trans: forall c x y z, compare x y = c -> compare y z = c -> compare x z = c. Proof using. intros c x. revert c. induction x; intros c y z; destruct y; simpl; intro H; auto; subst; try discriminate H; destruct z; simpl; intro H'; eauto; try discriminate H'. Qed. Lemma reflect: forall x y, compare x y = Eq -> x = y. Proof using. induction x; intros y; destruct y; simpl; intro H; auto; discriminate. Qed. End Nat_as_OTA. coq-serapi-8.20.0-0.20.0/tests/quick/reserved.v000066400000000000000000000010421466734233400206540ustar00rootroot00000000000000Require Import List String Ascii. Import ListNotations. Local Open Scope char. Module chars. Notation lparen := "("%char. Notation rparen := ")"%char. Notation space := " "%char. Notation newline := "010"%char. Definition reserved (a : ascii) : Prop := In a [lparen; rparen; newline; space]. Definition reserved_dec (a : ascii) : {reserved a} + {~ reserved a}. unfold reserved. apply in_dec. apply ascii_dec. Defined. Lemma lparen_reserved : reserved lparen. Proof using. red. intuition. Qed. End chars. coq-serapi-8.20.0-0.20.0/tests/sername/000077500000000000000000000000001466734233400171675ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/tests/sername/dune000066400000000000000000000003141466734233400200430ustar00rootroot00000000000000(rule (deps (package coq-serapi)) (action (with-stdout-to nat_add.log (run sername --de-bruijn --str-pp %{dep:nat_add.sername})))) (rule (alias runtest) (action (diff nat_add.out nat_add.log))) coq-serapi-8.20.0-0.20.0/tests/sername/nat_add.out000066400000000000000000000032741466734233400213200ustar00rootroot00000000000000Nat.add: "nat -> nat -> nat" (Prod((binder_name(Name(Id n)))(binder_relevance Relevant))(Ind(((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0)(Instance(()()))))(Prod((binder_name(Name(Id m)))(binder_relevance Relevant))(Ind(((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0)(Instance(()()))))(Ind(((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0)(Instance(()())))))) ((v(GProd Anonymous()Explicit((v(GRef(IndRef((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0))()))(loc()))((v(GProd Anonymous()Explicit((v(GRef(IndRef((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0))()))(loc()))((v(GRef(IndRef((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0))()))(loc()))))(loc()))))(loc())) Nat.mul: "nat -> nat -> nat" (Prod((binder_name(Name(Id n)))(binder_relevance Relevant))(Ind(((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0)(Instance(()()))))(Prod((binder_name(Name(Id m)))(binder_relevance Relevant))(Ind(((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0)(Instance(()()))))(Ind(((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0)(Instance(()())))))) ((v(GProd Anonymous()Explicit((v(GRef(IndRef((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0))()))(loc()))((v(GProd Anonymous()Explicit((v(GRef(IndRef((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0))()))(loc()))((v(GRef(IndRef((MutInd(KerName(MPfile(DirPath((Id Datatypes)(Id Init)(Id Coq))))(Id nat))())0))()))(loc()))))(loc()))))(loc())) coq-serapi-8.20.0-0.20.0/tests/sername/nat_add.sername000066400000000000000000000000241466734233400221310ustar00rootroot00000000000000Nat.add Nat.mul nat coq-serapi-8.20.0-0.20.0/tests/sertop/000077500000000000000000000000001466734233400170515ustar00rootroot00000000000000coq-serapi-8.20.0-0.20.0/tests/sertop/dune000066400000000000000000000007071466734233400177330ustar00rootroot00000000000000; Segfault in envs; thanks to Clément Pit-Claudel (rule (action (with-stdout-to full_env.log (with-stdin-from full_env.in (run sertop))))) (rule (targets full_env.out) (mode promote) (action (run gunzip %{dep:full_env.out.gz}))) ; Disabled as it is not reliable on different machines, moreover the ; test size is huge, we should find a better way to test univ.ml (rule (alias runtest-fragile) (action (diff full_env.out full_env.log))) coq-serapi-8.20.0-0.20.0/tests/sertop/full_env.in000066400000000000000000000010611466734233400212110ustar00rootroot00000000000000("query0"("Add"()"Require Coq.Vectors.Vector.\nRequire Import Coq.Strings.String Coq.Arith.PeanoNat.\nImport EqNotations Vector.VectorNotations.")) ("query1"("Exec""2")) ("query2"("Query"(("sid""2"))"EGoals")) ("query3"("Exec""3")) ("query4"("Query"(("sid""3"))"EGoals")) ("query5"("Exec""4")) ("query6"("Query"(("sid""4"))"EGoals")) ("query7"("Add"()"Lemma map_snoc_1234 :\n Vector.map (fun x => 2 * x) (cons 1 [2; 3; 4]) = [2; 4; 6; 8].\nProof.\n cbv -[Vector.map Nat.mul].\n Fail destruct (Nat.add_1_r 3). (* .messages *)\nAbort.")) ("query8"("Exec""5"))