diff options
184 files changed, 3875 insertions, 2802 deletions
diff --git a/.circleci/config.yml b/.circleci/config.yml deleted file mode 100644 index adab42c622..0000000000 --- a/.circleci/config.yml +++ /dev/null @@ -1,202 +0,0 @@ -# This file used to contain configuration to also build documentation and CoqIDE, -# run the test-suite and the validate targets, -# including with 32-bits architecture or bleeding-edge compiler. - -defaults: - params: ¶ms - # Following parameters are used in Coq CircleCI Job (using yaml - # reference syntax) - working_directory: ~/coq - docker: - - image: $CI_REGISTRY_IMAGE:$CACHEKEY - - environment: &envvars - CACHEKEY: "bionic_coq-V2018-07-11-V2" - CI_REGISTRY_IMAGE: registry.gitlab.com/coq/coq - -version: 2 - -before_script: &before_script - name: Setup OPAM Switch - command: | - echo export TERM=xterm >> ~/.profile - source ~/.profile - echo . ~/.profile >> $BASH_ENV - printenv | sort - opam switch "$COMPILER" - opam config list - opam list - -.build-template: &build-template - <<: *params - steps: - - checkout - - run: *before_script - - run: &build-clean - name: Clean - command: | - make clean # ensure that `make clean` works on a fresh clone - - run: &build-configure - name: Configure - command: | - ./configure -local -native-compiler ${NATIVE_COMP} -coqide no - - run: &build-build - name: Build - command: | - make -j ${NJOBS} byte - make -j ${NJOBS} - make test-suite/misc/universes/all_stdlib.v - - persist_to_workspace: - root: &workspace ~/ - paths: - - coq/ - - environment: - <<: *envvars - NATIVE_COMP: "yes" - -.ci-template: &ci-template - <<: *params - steps: - - run: *before_script - - attach_workspace: &attach_workspace - at: *workspace - - - run: - name: Test - command: | - dev/ci/ci-wrapper.sh ${CIRCLE_JOB} - - persist_to_workspace: - root: *workspace - paths: - - coq/ - environment: *envvars - -# Defines individual jobs, see the workflows section below for job orchestration -jobs: - - # Build and prepare test environment - build: *build-template - - bignums: - <<: *ci-template - - color: - <<: *ci-template - - compcert: - <<: *ci-template - - coq-dpdgraph: - <<: *ci-template - - coquelicot: - <<: *ci-template - - cross-crypto: - <<: *ci-template - - elpi: - <<: *ci-template - - equations: - <<: *ci-template - - geocoq: - <<: *ci-template - - fcsl-pcm: - <<: *ci-template - - fiat-crypto: - <<: *ci-template - - fiat-parsers: - <<: *ci-template - - flocq: - <<: *ci-template - - math-classes: - <<: *ci-template - - corn: - <<: *ci-template - - formal-topology: - <<: *ci-template - - hott: - <<: *ci-template - - iris-lambda-rust: - <<: *ci-template - - ltac2: - <<: *ci-template - - math-comp: - <<: *ci-template - - mtac2: - <<: *ci-template - - pidetop: - <<: *ci-template - - sf: - <<: *ci-template - - unimath: - <<: *ci-template - - vst: - <<: *ci-template - -workflows: - version: 2 - - # Run on each push - main: - jobs: - - build - - - bignums: &req-main - requires: - - build - - color: - requires: - - build - - bignums - # - compcert: *req-main - # - coq-dpdgraph: *req-main - # - coquelicot: *req-main - # - cross-crypto: *req-main - # - elpi: *req-main - # - equations: *req-main - # - geocoq: *req-main - # - fcsl-pcm: *req-main - # - fiat-crypto: *req-main - # - fiat-parsers: *req-main - # - flocq: *req-main - - math-classes: - requires: - - build - - bignums - # - mtac2: *req-main - - corn: - requires: - - build - - math-classes - - formal-topology: - requires: - - build - - corn - # - hott: *req-main - # - iris-lambda-rust: *req-main - # - ltac2: *req-main - # - math-comp: *req-main - # - pidetop: *req-main - # - sf: *req-main - # - unimath: *req-main - # - vst: *req-main diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 384e46723a..5be434c8b7 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -9,7 +9,6 @@ ########## CI infrastructure ########## /dev/ci/ @coq/ci-maintainers -/.circleci/ @coq/ci-maintainers /.travis.yml @coq/ci-maintainers /.gitlab-ci.yml @coq/ci-maintainers @@ -43,11 +42,7 @@ # Trick to avoid getting review requests # each time someone modifies the dev changelog -/doc/ @maximedenes -# Secondary maintainer @silene @Zimmi48 - -/doc/tools/coqrst/ @maximedenes -# Secondary maintainer @cpitclaudel +/doc/ @coq/doc-maintainers /man/ @silene # Secondary maintainer @maximedenes diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index c2ca6ebaa4..492b658d98 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -212,6 +212,9 @@ windows32: <<: *windows-template variables: ARCH: "32" + except: + - /^pr-.*$/ + pkg:nix: image: nixorg/nix:latest # Minimal NixOS image which doesn't even contain git @@ -334,6 +337,9 @@ ci-fcsl-pcm: ci-fiat-crypto: <<: *ci-template-flambda +ci-fiat-crypto-legacy: + <<: *ci-template-flambda + ci-fiat-parsers: <<: *ci-template @@ -5,6 +5,11 @@ Kernel - Mutually defined records are now supported. +Notations + +- New support for autonomous grammars of terms, called "custom + entries" (see chapter "Syntax extensions" of the reference manual). + Tactics - Added toplevel goal selector ! which expects a single focused goal. @@ -43,6 +48,12 @@ Tactics may need to add `Require Import Lra` to your developments. For compatibility, we now define `fourier` as a deprecated alias of `lra`. +Focusing + +- Focusing bracket `{` now supports named goal selectors, + e.g. `[x]: {` will focus on a goal (existential variable) named `x`. + As usual, unfocus with `}` once the sub-goal is fully solved. + Standard Library - Added `Ascii.eqb` and `String.eqb` and the `=?` notation for them, @@ -52,6 +63,8 @@ Standard Library Solution: wrap `_ =? _` in `(_ =? _)%Z` (or whichever scope you want). +- Added `Ndigits.N2Bv_sized`, and proved some lemmas about it. + Tools - Coq_makefile lets one override or extend the following variables from @@ -69,6 +82,7 @@ Tools please open an issue. We can help set up external maintenance as part of Proof-General, or independently as part of coq-community. + Vernacular Commands - Removed deprecated commands Arguments Scope and Implicit Arguments @@ -130,10 +144,27 @@ Display diffs between proof steps - coqtop and coqide can now highlight the differences between proof steps in color. This can be enabled from the command line or the - "Set Diffs on|off|removed" command. Please see the documentation for + `Set Diffs "on"|"off"|"removed"` command. Please see the documentation for details. Showing diffs in Proof General requires small changes to PG (under discussion). +Notations + +- Added `++` infix for `VectorDef.append`. + Note that this might cause incompatibilities if you have, e.g., list_scope + and vector_scope both open with vector_scope on top, and expect `++` to + refer to `app`. + Solution: wrap `_ ++ _` in `(_ ++ _)%list` (or whichever scope you want). + +Changes from 8.8.1 to 8.8.2 +=========================== + +Tools + +- The coq-makefile targets `print-pretty-timed`, `print-pretty-timed-diff`, + and `print-pretty-single-time-diff` now correctly label the "before" and + "after" columns, rather than swapping them. + Changes from 8.8.0 to 8.8.1 =========================== diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 9bd3d0b7c7..de7fb9183c 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -50,15 +50,28 @@ information on CI tests, including how to run them on your private branches. If your pull request fixes a bug, please consider adding a regression test as well. See [`test-suite/README.md`](test-suite/README.md) for how to do so. +If your pull request fixes a critical bug (a bug allowing a proof of `False`), +please add an entry to [`dev/doc/critical-bugs`](/dev/doc/critical-bugs). + Don't be alarmed if the pull request process takes some time. It can take a few days to get feedback, approval on the final changes, and then a merge. Coq doesn't release new versions very frequently so it can take a few months for your change to land in a released version. That said, you can start using the latest Coq `master` branch to take advantage of all the new features, improvements, and fixes. Whitespace discipline (do not indent using tabs, no trailing spaces, text files end with newlines) is checked by Travis (using `git diff --check`). We ship a [`dev/tools/pre-commit`](/dev/tools/pre-commit) git hook which fixes these errors at commit time. `configure` automatically sets you up to use it, unless you already have a hook at `.git/hooks/pre-commit`. Here are a few tags Coq developers may add to your PR and what they mean. In general feedback and requests for you as the pull request author will be in the comments and tags are only used to organize pull requests. -- [needs: rebase](https://github.com/coq/coq/pulls?utf8=%E2%9C%93&q=is%3Aopen%20is%3Apr%20label%3A%22needs%3A%20rebase%22) indicates the PR should be rebased on top of the latest `master` branch. See the [GitHub documentation](https://help.github.com/articles/about-git-rebase/) for a brief introduction to using `git rebase`. -- [needs: fixing](https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+fixing%22) indicates the PR needs a fix, as discussed in the comments. -- [needs: benchmarking](https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+benchmarking%22) and [needs: testing](https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+testing%22) indicate the PR needs testing beyond what the test suite can handle. For example, performance benchmarking is currently performed with a different infrastructure. Unless some followup is specifically requested you aren't expected to do this additional testing. +- [needs: rebase][rebase-label] indicates the PR should be rebased on top of + the latest base branch (usually `master`). See the + [GitHub documentation](https://help.github.com/articles/about-git-rebase/) + for a brief introduction to using `git rebase`. + This label will be automatically added if you open or synchronize your PR and + it is not up-to-date with the base branch. So please, do not forget to rebase + your branch every time you update it. +- [needs: fixing][fixing-label] indicates the PR needs a fix, as discussed in the comments. +- [needs: benchmarking][benchmarking-label] and [needs: testing][testing-label] + indicate the PR needs testing beyond what the test suite can handle. + For example, performance benchmarking is currently performed with a different + infrastructure ([documented in the wiki][jenkins-doc]). Unless some followup + is specifically requested you aren't expected to do this additional testing. To learn more about the merging process, you can read the [merging documentation for Coq maintainers](dev/doc/MERGING.md). @@ -98,3 +111,10 @@ External plugins / libraries contribute to create a successful ecosystem around Ask and answer questions on [Stack Exchange](https://stackexchange.com/filters/299857/questions-tagged-coq-on-stackexchange-sites) which has a helpful community of Coq users. Hang out on the Coq IRC channel, `irc://irc.freenode.net/#coq`, and help answer questions. + +[rebase-label]: https://github.com/coq/coq/pulls?utf8=%E2%9C%93&q=is%3Aopen%20is%3Apr%20label%3A%22needs%3A%20rebase%22 +[fixing-label]: https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+fixing%22 +[benchmarking-label]: https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+benchmarking%22 +[testing-label]: https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+testing%22 + +[jenkins-doc]: https://github.com/coq/coq/wiki/Jenkins-(automated-benchmarking) @@ -81,7 +81,7 @@ export ML4FILES := $(call find, '*.ml4') export MLGFILES := $(call find, '*.mlg') export CFILES := $(call findindir, 'kernel/byterun', '*.c') -export MERLININFILES := $(call find, '.merlin.in') +MERLININFILES := $(call find, '.merlin.in') export MERLINFILES := $(MERLININFILES:.in=) # NB: The lists of currently existing .ml and .mli files will change @@ -116,7 +116,7 @@ include Makefile.common NOARG: world -.PHONY: NOARG help noconfig submake +.PHONY: NOARG help noconfig submake camldevfiles help: @echo "Please use either:" @@ -143,12 +143,13 @@ Then, you may want to consider whether you want to restore the autosaves) #run. endif -# Apart from clean and tags, everything will be done in a sub-call to make -# on Makefile.build. This way, we avoid doing here the -include of .d : -# since they trigger some compilations, we do not want them for a mere clean. -# Moreover, we regroup this sub-call in a common target named 'submake'. -# This way, multiple user-given goals (cf the MAKECMDGOALS variable) won't -# trigger multiple (possibly parallel) make sub-calls +# Apart from clean and a few misc files, everything will be done in a +# sub-call to make on Makefile.build. This way, we avoid doing here +# the -include of .d : since they trigger some compilations, we do not +# want them for a mere clean. Moreover, we regroup this sub-call in a +# common target named 'submake'. This way, multiple user-given goals +# (cf the MAKECMDGOALS variable) won't trigger multiple (possibly +# parallel) make sub-calls ifdef COQ_CONFIGURED %:: submake ; @@ -161,7 +162,7 @@ MAKE_OPTS := --warn-undefined-variable --no-builtin-rules bin: mkdir bin -submake: alienclean | bin +submake: alienclean camldevfiles | bin $(MAKE) $(MAKE_OPTS) -f Makefile.build $(MAKECMDGOALS) noconfig: @@ -172,6 +173,20 @@ noconfig: Makefile $(wildcard Makefile.*) config/Makefile : ; ########################################################################### +# OCaml dev files +########################################################################### +camldevfiles: $(MERLINFILES) META.coq + +.merlin: .merlin.in + cp -a "$<" "$@" + +%/.merlin: %/.merlin.in + cp -a "$<" "$@" + +META.coq: META.coq.in + cp -a "$<" "$@" + +########################################################################### # Cleaning ########################################################################### diff --git a/Makefile.build b/Makefile.build index 05633cecc8..c100eda400 100644 --- a/Makefile.build +++ b/Makefile.build @@ -64,7 +64,7 @@ AFTER ?= # build the different subsystems: -world: camldevfiles coq coqide documentation revision +world: coq coqide documentation revision coq: coqlib coqbinaries tools diff --git a/Makefile.ci b/Makefile.ci index fce16906c4..e86504b76d 100644 --- a/Makefile.ci +++ b/Makefile.ci @@ -22,6 +22,7 @@ CI_TARGETS=ci-bedrock2 \ ci-equations \ ci-fcsl-pcm \ ci-fiat-crypto \ + ci-fiat-crypto-legacy \ ci-fiat-parsers \ ci-flocq \ ci-formal-topology \ @@ -35,6 +36,7 @@ CI_TARGETS=ci-bedrock2 \ ci-pidetop \ ci-quickchick \ ci-sf \ + ci-simple-io \ ci-tlc \ ci-unimath \ ci-vst @@ -53,7 +55,7 @@ ci-math-classes: ci-bignums ci-corn: ci-math-classes -ci-quickchick: ci-ext-lib +ci-quickchick: ci-ext-lib ci-simple-io ci-formal-topology: ci-corn diff --git a/Makefile.dev b/Makefile.dev index ea1a3d40a2..68e96a57b7 100644 --- a/Makefile.dev +++ b/Makefile.dev @@ -15,7 +15,7 @@ # Debug printers in dev/ ######################### -.PHONY: devel printers camldevfiles +.PHONY: devel printers DEBUGPRINTERS:=dev/top_printers.cmo dev/vm_printers.cmo dev/checker_printers.cmo @@ -85,20 +85,6 @@ endif # But these partial targets could be quite handy for quick builds # of specific components of Coq. -########################################################################### -# OCaml dev files -########################################################################### -camldevfiles: $(MERLINFILES) META.coq - -.merlin: .merlin.in - cp -a "$<" "$@" - -%/.merlin: %/.merlin.in - cp -a "$<" "$@" - -META.coq: META.coq.in - cp -a "$<" "$@" - ############################### ### 1) general-purpose targets ############################### diff --git a/Makefile.doc b/Makefile.doc index dde3a37b70..1b1198c1f2 100644 --- a/Makefile.doc +++ b/Makefile.doc @@ -33,6 +33,10 @@ HTMLSTYLE:=coqremote # Sphinx-related variables SPHINXENV:=COQBIN="$(CURDIR)/bin/" SPHINXOPTS= -j4 +SPHINXWARNERROR ?= 1 +ifeq ($(SPHINXWARNERROR),1) +SPHINXOPTS += -W +endif SPHINXBUILD= sphinx-build SPHINXBUILDDIR= doc/sphinx/_build @@ -56,7 +60,7 @@ endif sphinx: $(SPHINX_DEPS) $(SHOW)'SPHINXBUILD doc/sphinx' - $(HIDE)$(SPHINXENV) $(SPHINXBUILD) -W -b html $(ALLSPHINXOPTS) doc/sphinx $(SPHINXBUILDDIR)/html + $(HIDE)$(SPHINXENV) $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) doc/sphinx $(SPHINXBUILDDIR)/html @echo @echo "Build finished. The HTML pages are in $(SPHINXBUILDDIR)/html." @@ -3,7 +3,6 @@ [](https://gitlab.com/coq/coq/commits/master) [](https://travis-ci.org/coq/coq/builds) [](https://ci.appveyor.com/project/coq/coq/branch/master) -[](https://circleci.com/gh/coq/workflows/coq/tree/master) [](https://gitter.im/coq/coq) [](https://doi.org/10.5281/zenodo.1003420) diff --git a/clib/cList.ml b/clib/cList.ml index de42886dcb..dc59ff2970 100644 --- a/clib/cList.ml +++ b/clib/cList.ml @@ -60,6 +60,7 @@ sig val extend : bool list -> 'a -> 'a list -> 'a list val count : ('a -> bool) -> 'a list -> int val index : 'a eq -> 'a -> 'a list -> int + val safe_index : 'a eq -> 'a -> 'a list -> int option val index0 : 'a eq -> 'a -> 'a list -> int val fold_left_until : ('c -> 'a -> 'c CSig.until) -> 'c -> 'a list -> 'c val fold_right_i : (int -> 'a -> 'b -> 'b) -> int -> 'a list -> 'b -> 'b @@ -538,6 +539,8 @@ let rec index_f f x l n = match l with let index f x l = index_f f x l 1 +let safe_index f x l = try Some (index f x l) with Not_found -> None + let index0 f x l = index_f f x l 0 (** {6 Folding} *) diff --git a/clib/cList.mli b/clib/cList.mli index 42fae5ed39..ed468cb977 100644 --- a/clib/cList.mli +++ b/clib/cList.mli @@ -155,6 +155,10 @@ sig val index : 'a eq -> 'a -> 'a list -> int (** [index] returns the 1st index of an element in a list (counting from 1). *) + val safe_index : 'a eq -> 'a -> 'a list -> int option + (** [safe_index] returns the 1st index of an element in a list (counting from 1) + and None otherwise. *) + val index0 : 'a eq -> 'a -> 'a list -> int (** [index0] behaves as [index] except that it starts counting at 0. *) diff --git a/configure.ml b/configure.ml index 7fd900d995..7e0fd4c8ac 100644 --- a/configure.ml +++ b/configure.ml @@ -1214,8 +1214,8 @@ let write_configml f = pr_s "browser" browser; pr_s "wwwcoq" !prefs.coqwebsite; pr_s "wwwbugtracker" (!prefs.coqwebsite ^ "bugs/"); - pr_s "wwwrefman" (!prefs.coqwebsite ^ "distrib/" ^ coq_version ^ "/refman/"); - pr_s "wwwstdlib" (!prefs.coqwebsite ^ "distrib/" ^ coq_version ^ "/stdlib/"); + pr_s "wwwrefman" (!prefs.coqwebsite ^ "distrib/V" ^ coq_version ^ "/refman/"); + pr_s "wwwstdlib" (!prefs.coqwebsite ^ "distrib/V" ^ coq_version ^ "/stdlib/"); pr_s "localwwwrefman" ("file:/" ^ docdir ^ "/html/refman"); pr_b "bytecode_compiler" !prefs.bytecodecompiler; pr_b "native_compiler" !prefs.nativecompiler; diff --git a/coqpp/coqpp_main.ml b/coqpp/coqpp_main.ml index e76a1e9ed8..fd425ef4ff 100644 --- a/coqpp/coqpp_main.ml +++ b/coqpp/coqpp_main.ml @@ -326,10 +326,14 @@ let print_ast fmt ext = end +let declare_plugin fmt name = + fprintf fmt "let %s = \"%s\"@\n" plugin_name name; + fprintf fmt "let _ = Mltop.add_known_module %s@\n" plugin_name + let pr_ast fmt = function | Code s -> fprintf fmt "%s@\n" s.code | Comment s -> fprintf fmt "%s@\n" s -| DeclarePlugin name -> fprintf fmt "let %s = \"%s\"@\n" plugin_name name +| DeclarePlugin name -> declare_plugin fmt name | GramExt gram -> fprintf fmt "%a@\n" GramExt.print_ast gram | VernacExt -> fprintf fmt "VERNACEXT@\n" | TacticExt tac -> fprintf fmt "%a@\n" TacticExt.print_ast tac diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh index da5ac2b15c..521dfe2a3f 100644 --- a/dev/build/windows/makecoq_mingw.sh +++ b/dev/build/windows/makecoq_mingw.sh @@ -793,7 +793,7 @@ function make_ln { function make_ocaml { get_flex_dll_link_bin - if build_prep http://caml.inria.fr/pub/distrib/ocaml-4.07 ocaml-4.07.0 tar.gz 1 ; then + if build_prep https://github.com/ocaml/ocaml/archive 4.07.0 tar.gz 1 ocaml-4.07.0 ; then # See README.win32.adoc cp config/m-nt.h byterun/caml/m.h cp config/s-nt.h byterun/caml/s.h diff --git a/dev/ci/README.md b/dev/ci/README.md index 45176581cd..a814e4914e 100644 --- a/dev/ci/README.md +++ b/dev/ci/README.md @@ -75,9 +75,6 @@ We are currently running tests on the following platforms: camlp5, and with warnings as errors; it runs the test-suite and tests the compilation of several external developments. -- Circle CI runs tests that are redundant with GitLab CI and may be removed - eventually. - - Travis CI is used to test the compilation of Coq and run the test-suite on macOS. It also runs a linter that checks whitespace discipline. A [pre-commit hook](../tools/pre-commit) is automatically installed by @@ -141,14 +138,11 @@ persists to and is used by the next jobs. Artifacts can also be downloaded from the GitLab repository. Currently, available artifacts are: -- the Coq executables and stdlib, in three copies varying in +- the Coq executables and stdlib, in four copies varying in architecture and OCaml version used to build Coq. -- the Coq documentation, built only in the `build:base` job. When submitting +- the Coq documentation, built in the `documentation` job. When submitting a documentation PR, this can help reviewers checking the rendered result. -As an exception to the above, jobs testing that compilation triggers -no OCaml warnings build Coq in parallel with other tests. - ### GitLab and Windows If your repository has access to runners tagged `windows`, setting the @@ -165,8 +159,7 @@ automatically built and uploaded to your GitLab registry, and is loaded by subsequent jobs. **IMPORTANT**: When updating Coq's CI docker image, you must modify -the `CACHEKEY` variable in [`.gitlab-ci.yml`](../../.gitlab-ci.yml), -[`.circleci/config.yml`](../../.circleci/config.yml), +the `CACHEKEY` variable in [`.gitlab-ci.yml`](../../.gitlab-ci.yml) and [`Dockerfile`](docker/bionic_coq/Dockerfile) The Docker building job reuses the uploaded image if it is available, diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh index 28321d13e2..a77eb15e92 100755 --- a/dev/ci/ci-basic-overlay.sh +++ b/dev/ci/ci-basic-overlay.sh @@ -184,6 +184,12 @@ : "${ext_lib_CI_GITURL:=https://github.com/coq-ext-lib/coq-ext-lib}" ######################################################################## +# simple-io +######################################################################## +: "${simple_io_CI_BRANCH:=master}" +: "${simple_io_CI_GITURL:=https://github.com/Lysxia/coq-simple-io}" + +######################################################################## # quickchick ######################################################################## : "${quickchick_CI_BRANCH:=master}" diff --git a/dev/ci/ci-common.sh b/dev/ci/ci-common.sh index a68cd0933e..9259a6e0c8 100644 --- a/dev/ci/ci-common.sh +++ b/dev/ci/ci-common.sh @@ -20,10 +20,6 @@ else then export CI_PULL_REQUEST="$TRAVIS_PULL_REQUEST" export CI_BRANCH="$TRAVIS_BRANCH" - elif [ -n "${CIRCLECI}" ]; - then - export CI_PULL_REQUEST="$CIRCLE_PR_NUMBER" - export CI_BRANCH="$CIRCLE_BRANCH" else # assume local CI_BRANCH="$(git rev-parse --abbrev-ref HEAD)" export CI_BRANCH diff --git a/dev/ci/ci-fiat-crypto-legacy.sh b/dev/ci/ci-fiat-crypto-legacy.sh new file mode 100755 index 0000000000..9429344159 --- /dev/null +++ b/dev/ci/ci-fiat-crypto-legacy.sh @@ -0,0 +1,14 @@ +#!/usr/bin/env bash + +ci_dir="$(dirname "$0")" +. "${ci_dir}/ci-common.sh" + +fiat_crypto_CI_DIR="${CI_BUILD_DIR}/fiat-crypto" + +git_checkout "${fiat_crypto_CI_BRANCH}" "${fiat_crypto_CI_GITURL}" "${fiat_crypto_CI_DIR}" + +( cd "${fiat_crypto_CI_DIR}" && git submodule update --init --recursive ) + +fiat_crypto_legacy_CI_TARGETS1="print-old-pipeline-lite old-pipeline-lite lite-display" +fiat_crypto_legacy_CI_TARGETS2="print-old-pipeline-nobigmem old-pipeline-nobigmem nonautogenerated-specific nonautogenerated-specific-display" +( cd "${fiat_crypto_CI_DIR}" && make ${fiat_crypto_legacy_CI_TARGETS1} && make -j 1 ${fiat_crypto_legacy_CI_TARGETS2} ) diff --git a/dev/ci/ci-fiat-crypto.sh b/dev/ci/ci-fiat-crypto.sh index 48a1366aba..c6d2f0cfd9 100755 --- a/dev/ci/ci-fiat-crypto.sh +++ b/dev/ci/ci-fiat-crypto.sh @@ -9,6 +9,7 @@ git_checkout "${fiat_crypto_CI_BRANCH}" "${fiat_crypto_CI_GITURL}" "${fiat_crypt ( cd "${fiat_crypto_CI_DIR}" && git submodule update --init --recursive ) -fiat_crypto_CI_TARGETS1="printlite lite lite-display" -fiat_crypto_CI_TARGETS2="print-nobigmem nobigmem nonautogenerated-specific nonautogenerated-specific-display" -( cd "${fiat_crypto_CI_DIR}" && make ${fiat_crypto_CI_TARGETS1} && make -j 1 ${fiat_crypto_CI_TARGETS2} ) +# We need a larger stack size to not overflow ocamlopt+flambda when +# building the executables. +# c.f. https://github.com/coq/coq/pull/8313#issuecomment-416650241 +( cd "${fiat_crypto_CI_DIR}" && ulimit -s 32768 && make new-pipeline c-files ) diff --git a/dev/ci/ci-hott.sh b/dev/ci/ci-hott.sh index 6ded97984e..184b90a50b 100755 --- a/dev/ci/ci-hott.sh +++ b/dev/ci/ci-hott.sh @@ -7,4 +7,4 @@ HoTT_CI_DIR="${CI_BUILD_DIR}"/HoTT git_checkout "${HoTT_CI_BRANCH}" "${HoTT_CI_GITURL}" "${HoTT_CI_DIR}" -( cd "${HoTT_CI_DIR}" && ./autogen.sh && ./configure && make ) +( cd "${HoTT_CI_DIR}" && ./autogen.sh && ./configure && make && make validate ) diff --git a/dev/ci/ci-simple-io.sh b/dev/ci/ci-simple-io.sh new file mode 100755 index 0000000000..66f9801b3c --- /dev/null +++ b/dev/ci/ci-simple-io.sh @@ -0,0 +1,10 @@ +#!/usr/bin/env bash + +ci_dir="$(dirname "$0")" +. "${ci_dir}/ci-common.sh" + +simple_io_CI_DIR="${CI_BUILD_DIR}/simple-io" + +git_checkout "${simple_io_CI_BRANCH}" "${simple_io_CI_GITURL}" "${simple_io_CI_DIR}" + +( cd "${simple_io_CI_DIR}" && make build && make install) diff --git a/dev/ci/user-overlays/07859-printers.sh b/dev/ci/user-overlays/07859-printers.sh new file mode 100644 index 0000000000..27f588e214 --- /dev/null +++ b/dev/ci/user-overlays/07859-printers.sh @@ -0,0 +1,6 @@ +#!/bin/sh + +if [ "$CI_PULL_REQUEST" = "7859" ] || [ "$CI_BRANCH" = "rm-univ-broken-printing" ]; then + Equations_CI_BRANCH=fix-printers + Equations_CI_GITURL=https://github.com/SkySkimmer/Coq-Equations +fi diff --git a/doc/README.md b/doc/README.md index 6c6e1f01fb..3e70bc443d 100644 --- a/doc/README.md +++ b/doc/README.md @@ -9,7 +9,7 @@ The Coq documentation includes The documentation of the latest released version is available on the Coq web site at [coq.inria.fr/documentation](http://coq.inria.fr/documentation). -Additionnally, you can view the documentation for the current master version at +Additionally, you can view the documentation for the current master version at <https://gitlab.com/coq/coq/-/jobs/artifacts/master/file/_install_ci/share/doc/coq/sphinx/html/index.html?job=documentation>. The reference manual is written is reStructuredText and compiled @@ -89,6 +89,18 @@ Alternatively, you can use some specific targets: Also note the `-with-doc yes` option of `./configure` to enable the build of the documentation as part of the default make target. +If you're editing Sphinx documentation, set SPHINXWARNERROR to 0 +to avoid treating Sphinx warnings as errors. Otherwise, Sphinx quits +upon detecting the first warning. You can set this on the Sphinx `make` +command line or as an environment variable: + +- `make sphinx SPINXWARNERROR=0` + +- ~~~ + export SPHINXWARNERROR=0 + ⋮ + make sphinx + ~~~ Installation ------------ diff --git a/doc/sphinx/README.rst b/doc/sphinx/README.rst index 30ac2cec80..4673107e3d 100644 --- a/doc/sphinx/README.rst +++ b/doc/sphinx/README.rst @@ -239,6 +239,9 @@ In addition to the objects above, the ``coqrst`` Sphinx plugin defines the follo http://docutils.sourceforge.net/docs/ref/rst/directives.html#generic-admonition for more details. + Optionally, any text immediately following the ``.. example::`` header is + used as the example's title. + Example:: .. example:: Adding a hint to a database @@ -300,7 +303,7 @@ In addition to the objects and directives above, the ``coqrst`` Sphinx plugin de it names the introduced hypothesis :token:`ident`. Note that this example also uses ``:token:``. That's because ``ident`` is - defined in the the Coq manual as a grammar production, and ``:token:`` + defined in the Coq manual as a grammar production, and ``:token:`` creates a link to that. When referring to a placeholder that happens to be a grammar production, ``:token:`…``` is typically preferable to ``:n:`@…```. diff --git a/doc/sphinx/addendum/canonical-structures.rst b/doc/sphinx/addendum/canonical-structures.rst index 6843e9eaa1..2cc1f95c08 100644 --- a/doc/sphinx/addendum/canonical-structures.rst +++ b/doc/sphinx/addendum/canonical-structures.rst @@ -6,14 +6,14 @@ Canonical Structures :Authors: Assia Mahboubi and Enrico Tassi -This chapter explains the basics of Canonical Structure and how they can be used +This chapter explains the basics of canonical structures and how they can be used to overload notations and build a hierarchy of algebraic structures. The examples are taken from :cite:`CSwcu`. We invite the interested reader to refer to this paper for all the details that are omitted here for brevity. The interested reader shall also find in :cite:`CSlessadhoc` a detailed description -of another, complementary, use of Canonical Structures: advanced proof search. +of another, complementary, use of canonical structures: advanced proof search. This latter papers also presents many techniques one can employ to tune the -inference of Canonical Structures. +inference of canonical structures. Notation overloading @@ -38,21 +38,21 @@ of the terms that are compared. End theory. End EQ. -We use Coq modules as name spaces. This allows us to follow the same +We use Coq modules as namespaces. This allows us to follow the same pattern and naming convention for the rest of the chapter. The base -name space contains the definitions of the algebraic structure. To +namespace contains the definitions of the algebraic structure. To keep the example small, the algebraic structure ``EQ.type`` we are defining is very simplistic, and characterizes terms on which a binary relation is defined, without requiring such relation to validate any property. The inner theory module contains the overloaded notation ``==`` -and will eventually contain lemmas holding on all the instances of the +and will eventually contain lemmas holding all the instances of the algebraic structure (in this case there are no lemmas). Note that in practice the user may want to declare ``EQ.obj`` as a coercion, but we will not do that here. The following line tests that, when we assume a type ``e`` that is in -theEQ class, then we can relates two of its objects with ``==``. +theEQ class, we can relate two of its objects with ``==``. .. coqtop:: all @@ -75,7 +75,7 @@ We amend that by equipping ``nat`` with a comparison relation. Check 3 == 3. Eval compute in 3 == 4. -This last test shows that |Coq| is now not only able to typecheck ``3 == 3``, +This last test shows that |Coq| is now not only able to type check ``3 == 3``, but also that the infix relation was bound to the ``nat_eq`` relation. This relation is selected whenever ``==`` is used on terms of type nat. This can be read in the line declaring the canonical structure @@ -312,7 +312,7 @@ The following script registers an ``LEQ`` class for ``nat`` and for the type constructor ``*``. It also tests that they work as expected. Unfortunately, these declarations are very verbose. In the following -subsection we show how to make these declaration more compact. +subsection we show how to make them more compact. .. coqtop:: all @@ -385,7 +385,7 @@ with message "T is not an EQ.type"”. The other utilities are used to ask |Coq| to solve a specific unification problem, that will in turn require the inference of some canonical structures. -They are explained in mode details in :cite:`CSwcu`. +They are explained in more details in :cite:`CSwcu`. We now have all we need to create a compact “packager” to declare instances of the ``LEQ`` class. diff --git a/doc/sphinx/addendum/extended-pattern-matching.rst b/doc/sphinx/addendum/extended-pattern-matching.rst index c4f0147728..f7fd4b9146 100644 --- a/doc/sphinx/addendum/extended-pattern-matching.rst +++ b/doc/sphinx/addendum/extended-pattern-matching.rst @@ -11,7 +11,7 @@ Extended pattern-matching This section describes the full form of pattern-matching in |Coq| terms. -.. |rhs| replace:: right hand side +.. |rhs| replace:: right hand sides Patterns -------- @@ -39,12 +39,12 @@ value. A pattern of the form :n:`pattern | pattern` is called disjunctive. A list of patterns separated with commas is also considered as a pattern and is called *multiple pattern*. However multiple patterns can only occur at the root of pattern-matching equations. Disjunctions of -*multiple pattern* are allowed though. +*multiple patterns* are allowed though. Since extended ``match`` expressions are compiled into the primitive ones, -the expressiveness of the theory remains the same. Once the stage of -parsing has finished only simple patterns remain. Re-nesting of -pattern is performed at printing time. An easy way to see the result +the expressiveness of the theory remains the same. Once parsing has finished +only simple patterns remain. The original nesting of the ``match`` expressions +is recovered at printing time. An easy way to see the result of the expansion is to toggle off the nesting performed at printing (use here :opt:`Printing Matching`), then by printing the term with :cmd:`Print` if the term is a constant, or using the command :cmd:`Check`. @@ -150,12 +150,12 @@ second one and :g:`false` otherwise. We can write it as follows: | S n, S m => lef n m end. -Note that the first and the second multiple pattern superpose because +Note that the first and the second multiple pattern overlap because the couple of values ``O O`` matches both. Thus, what is the result of the function on those values? To eliminate ambiguity we use the *textual -priority rule*: we consider patterns ordered from top to bottom, then -a value is matched by the pattern at the ith row if and only if it is -not matched by some pattern of a previous row. Thus in the example,O O +priority rule:* we consider patterns to be ordered from top to bottom. A +value is matched by the pattern at the ith row if and only if it is +not matched by some pattern from a previous row. Thus in the example, ``O O`` is matched by the first pattern, and so :g:`(lef O O)` yields true. Another way to write this function is: @@ -201,7 +201,7 @@ instance, :g:`max` can be rewritten as follows: | 0, p | p, 0 => p end. -Similarly, factorization of (non necessary multiple) patterns that +Similarly, factorization of (not necessarily multiple) patterns that share the same variables is possible by using the notation :n:`{+| @pattern}`. Here is an example: @@ -312,7 +312,7 @@ Matching objects of dependent types The previous examples illustrate pattern matching on objects of non- dependent types, but we can also use the expansion strategy to -destructure objects of dependent type. Consider the type :g:`listn` of +destructure objects of dependent types. Consider the type :g:`listn` of lists of a certain length: .. coqtop:: in reset @@ -353,12 +353,12 @@ Dependent pattern matching ~~~~~~~~~~~~~~~~~~~~~~~~~~ The examples given so far do not need an explicit elimination -predicate because all the |rhs| have the same type and the strategy +predicate because all the |rhs| have the same type and Coq succeeds to synthesize it. Unfortunately when dealing with dependent -patterns it often happens that we need to write cases where the type +patterns it often happens that we need to write cases where the types of the |rhs| are different instances of the elimination predicate. The -function concat for listn is an example where the branches have -different type and we need to provide the elimination predicate: +function :g:`concat` for :g:`listn` is an example where the branches have +different types and we need to provide the elimination predicate: .. coqtop:: in @@ -374,7 +374,7 @@ In general if :g:`m` has type :g:`(I q1 … qr t1 … ts)` where :g:`q1, …, qr are parameters, the elimination predicate should be of the form :g:`fun y1 … ys x : (I q1 … qr y1 … ys ) => Q`. In the concrete syntax, it should be written : -``match m as x in (I _ … _ y1 … ys) return Q with … end`` +``match m as x in (I _ … _ y1 … ys) return Q with … end``. The variables which appear in the ``in`` and ``as`` clause are new and bounded in the property :g:`Q` in the return clause. The parameters of the inductive definitions should not be mentioned and are replaced by ``_``. @@ -385,9 +385,9 @@ Multiple dependent pattern matching Recall that a list of patterns is also a pattern. So, when we destructure several terms at the same time and the branches have different types we need to provide the elimination predicate for this -multiple pattern. It is done using the same scheme, each term may be -associated to an as and in clause in order to introduce a dependent -product. +multiple pattern. It is done using the same scheme: each term may be +associated to an ``as`` clause and an ``in`` clause in order to introduce +a dependent product. For example, an equivalent definition for :g:`concat` (even though the matching on the second term is trivial) would have been: @@ -414,7 +414,7 @@ length, by writing | consn n' a y, x => consn (n' + m) a (concat n' y m x) end. -I have a copy of :g:`b` in type :g:`listn 0` resp :g:`listn (S n')`. +we have a copy of :g:`b` in type :g:`listn 0` resp. :g:`listn (S n')`. .. _match-in-patterns: @@ -425,7 +425,7 @@ If the type of the matched term is more precise than an inductive applied to variables, arguments of the inductive in the ``in`` branch can be more complicated patterns than a variable. -Moreover, constructors whose type do not follow the same pattern will +Moreover, constructors whose types do not follow the same pattern will become impossible branches. In an impossible branch, you can answer anything but False_rect unit has the advantage to be subterm of anything. @@ -448,8 +448,8 @@ Using pattern matching to write proofs In all the previous examples the elimination predicate does not depend on the object(s) matched. But it may depend and the typical case is when we write a proof by induction or a function that yields an object -of dependent type. An example of proof using match in given in Section -8.2.3. +of a dependent type. An example of a proof written using ``match`` is given +in the description of the tactic :tacn:`refine`. For example, we can write the function :g:`buildlist` that given a natural number :g:`n` builds a list of length :g:`n` containing zeros as follows: @@ -572,7 +572,7 @@ When does the expansion strategy fail? -------------------------------------- The strategy works very like in ML languages when treating patterns of -non-dependent type. But there are new cases of failure that are due to +non-dependent types. But there are new cases of failure that are due to the presence of dependencies. The error messages of the current implementation may be sometimes diff --git a/doc/sphinx/addendum/extraction.rst b/doc/sphinx/addendum/extraction.rst index cb93d48a41..e3d25cf5cf 100644 --- a/doc/sphinx/addendum/extraction.rst +++ b/doc/sphinx/addendum/extraction.rst @@ -116,13 +116,13 @@ be optimized in order to be efficient (for instance, when using induction principles we do not want to compute all the recursive calls but only the needed ones). So the extraction mechanism provides an automatic optimization routine that will be called each time the user -want to generate |OCaml| programs. The optimizations can be split in two +wants to generate an |OCaml| program. The optimizations can be split in two groups: the type-preserving ones (essentially constant inlining and reductions) and the non type-preserving ones (some function abstractions of dummy types are removed when it is deemed safe in order to have more elegant types). Therefore some constants may not appear in the resulting monolithic |OCaml| program. In the case of modular extraction, -even if some inlining is done, the inlined constant are nevertheless +even if some inlining is done, the inlined constants are nevertheless printed, to ensure session-independent programs. Concerning Haskell, type-preserving optimizations are less useful @@ -185,7 +185,7 @@ The type-preserving optimizations are controlled by the following |Coq| options: **Inlining and printing of a constant declaration:** -A user can explicitly ask for a constant to be extracted by two means: +The user can explicitly ask for a constant to be extracted by two means: * by mentioning it on the extraction command line @@ -224,19 +224,18 @@ principles of extraction (logical parts and types). When an actual extraction takes place, an error is normally raised if the :cmd:`Extraction Implicit` declarations cannot be honored, that is -if any of the implicited variables still occurs in the final code. +if any of the implicit arguments still occurs in the final code. This behavior can be relaxed via the following option: .. opt:: Extraction SafeImplicits Default is on. When this option is off, a warning is emitted - instead of an error if some implicited variables still occur in the + instead of an error if some implicit arguments still occur in the final code of an extraction. This way, the extracted code may be obtained nonetheless and reviewed manually to locate the source of the issue - (in the code, some comments mark the location of these remaining - implicited variables). + (in the code, some comments mark the location of these remaining implicit arguments). Note that this extracted code might not compile or run properly, - depending of the use of these remaining implicited variables. + depending of the use of these remaining implicit arguments. Realizing axioms ~~~~~~~~~~~~~~~~ @@ -296,7 +295,7 @@ The number of type variables is checked by the system. For example: Realizing an axiom via :cmd:`Extract Constant` is only useful in the case of an informative axiom (of sort ``Type`` or ``Set``). A logical axiom -have no computational content and hence will not appears in extracted +has no computational content and hence will not appear in extracted terms. But a warning is nonetheless issued if extraction encounters a logical axiom. This warning reminds user that inconsistent logical axioms may lead to incorrect or non-terminating extracted terms. @@ -312,7 +311,7 @@ Realizing inductive types The system also provides a mechanism to specify ML terms for inductive types and constructors. For instance, the user may want to use the ML -native boolean type instead of |Coq| one. The syntax is the following: +native boolean type instead of the |Coq| one. The syntax is the following: .. cmd:: Extract Inductive @qualid => @string [ {+ @string } ] @@ -332,10 +331,10 @@ native boolean type instead of |Coq| one. The syntax is the following: branches in functional form, and then the inductive element to destruct. For instance, the match branch ``| S n => foo`` gives the functional form ``(fun n -> foo)``. Note that a constructor with no - argument is considered to have one unit argument, in order to block + arguments is considered to have one unit argument, in order to block early evaluation of the branch: ``| O => bar`` leads to the functional form ``(fun () -> bar)``. For instance, when extracting ``nat`` - into |OCaml| ``int``, the code to provide has type: + into |OCaml| ``int``, the code to be provided has type: ``(unit->'a)->(int->'a)->int->'a``. .. caution:: As for :cmd:`Extract Constant`, this command should be used with care: @@ -371,7 +370,7 @@ Typical examples are the following: When extracting to |OCaml|, if an inductive constructor or type has arity 2 and the corresponding string is enclosed by parentheses, and the string meets |OCaml|'s lexical criteria for an infix symbol, then the rest of the string is - used as infix constructor or type. + used as an infix constructor or type. .. coqtop:: in @@ -389,7 +388,7 @@ Avoiding conflicts with existing filenames ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When using :cmd:`Extraction Library`, the names of the extracted files -directly depends from the names of the |Coq| files. It may happen that +directly depend on the names of the |Coq| files. It may happen that these filenames are in conflict with already existing files, either in the standard library of the target language or in other code that is meant to be linked with the extracted code. @@ -424,7 +423,7 @@ a generic type ``'a`` to any term. First, if some part of the program is *very* polymorphic, there may be no ML type for it. In that case the extraction to ML works alright but the generated code may be refused by the ML -type-checker. A very well known example is the ``distr-pair`` +type checker. A very well known example is the ``distr-pair`` function: .. coqtop:: in @@ -459,7 +458,7 @@ In |OCaml|, we must cast any argument of the constructor dummy Even with those unsafe castings, you should never get error like ``segmentation fault``. In fact even if your program may seem -ill-typed to the |OCaml| type-checker, it can't go wrong : it comes +ill-typed to the |OCaml| type checker, it can't go wrong : it comes from a Coq well-typed terms, so for example inductive types will always have the correct number of arguments, etc. Of course, when launching manually some extracted function, you should apply it to arguments @@ -470,22 +469,23 @@ found in :cite:`Let02`. We have to say, though, that in most "realistic" programs, these problems do not occur. For example all the programs of Coq library are accepted by the |OCaml| -type-checker without any ``Obj.magic`` (see examples below). +type checker without any ``Obj.magic`` (see examples below). Some examples ------------- -We present here two examples of extractions, taken from the -|Coq| Standard Library. We choose |OCaml| as target language, -but all can be done in the other dialects with slight modifications. +We present here two examples of extraction, taken from the +|Coq| Standard Library. We choose |OCaml| as the target language, +but everything, with slight modifications, can also be done in the +other languages supported by extraction. We then indicate where to find other examples and tests of extraction. A detailed example: Euclidean division ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The file ``Euclid`` contains the proof of Euclidean division. -The natural numbers used there are unary integers of type ``nat``, -defined by two constructors ``O`` and ``S``. +The natural numbers used here are unary, represented by the type``nat``, +which is defined by two constructors ``O`` and ``S``. This module contains a theorem ``eucl_dev``, whose type is:: forall b:nat, b > 0 -> forall a:nat, diveucl a b @@ -579,7 +579,7 @@ extraction test: * ``stalmarck`` : https://github.com/coq-contribs/stalmarck Note that ``continuations`` and ``multiplier`` are a bit particular. They are -examples of developments where ``Obj.magic`` are needed. This is -probably due to an heavy use of impredicativity. After compilation, those +examples of developments where ``Obj.magic`` is needed. This is +probably due to a heavy use of impredicativity. After compilation, those two examples run nonetheless, thanks to the correction of the extraction :cite:`Let02`. diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst index e4d24a1f7e..e0babb6c4e 100644 --- a/doc/sphinx/addendum/generalized-rewriting.rst +++ b/doc/sphinx/addendum/generalized-rewriting.rst @@ -22,19 +22,18 @@ The new implementation is a drop-in replacement for the old one [#tabareau]_, hence most of the documentation still applies. The work is a complete rewrite of the previous implementation, based -on the type class infrastructure. It also improves on and generalizes +on the typeclass infrastructure. It also improves on and generalizes the previous implementation in several ways: - -+ User-extensible algorithm. The algorithm is separated in two parts: - generations of the rewriting constraints (done in ML) and solving of - these constraints using type class resolution. As type class ++ User-extensible algorithm. The algorithm is separated into two parts: + generation of the rewriting constraints (written in ML) and solving + these constraints using typeclass resolution. As typeclass resolution is extensible using tactics, this allows users to define general ways to solve morphism constraints. -+ Sub-relations. An example extension to the base algorithm is the ++ Subrelations. An example extension to the base algorithm is the ability to define one relation as a subrelation of another so that morphism declarations on one relation can be used automatically for - the other. This is done purely using tactics and type class search. + the other. This is done purely using tactics and typeclass search. + Rewriting under binders. It is possible to rewrite under binders in the new implementation, if one provides the proper morphisms. Again, most of the work is handled in the tactics. @@ -58,41 +57,41 @@ Relations and morphisms ~~~~~~~~~~~~~~~~~~~~~~~ A parametric *relation* ``R`` is any term of type -``forall (x1 :T1 ) ... (xn :Tn ), relation A``. +``forall (x1 : T1) ... (xn : Tn), relation A``. The expression ``A``, which depends on ``x1 ... xn`` , is called the *carrier* of the relation and ``R`` is said to be a relation over ``A``; the list ``x1,...,xn`` is the (possibly empty) list of parameters of the relation. -**Example 1 (Parametric relation):** +.. example:: Parametric relation -It is possible to implement finite sets of elements of type ``A`` as -unordered list of elements of type ``A``. -The function ``set_eq: forall (A: Type), relation (list A)`` -satisfied by two lists with the same elements is a parametric relation -over ``(list A)`` with one parameter ``A``. The type of ``set_eq`` -is convertible with ``forall (A: Type), list A -> list A -> Prop.`` + It is possible to implement finite sets of elements of type ``A`` as + unordered lists of elements of type ``A``. + The function ``set_eq: forall (A : Type), relation (list A)`` + satisfied by two lists with the same elements is a parametric relation + over ``(list A)`` with one parameter ``A``. The type of ``set_eq`` + is convertible with ``forall (A : Type), list A -> list A -> Prop.`` An *instance* of a parametric relation ``R`` with n parameters is any term -``(R t1 ... tn )``. +``(R t1 ... tn)``. Let ``R`` be a relation over ``A`` with ``n`` parameters. A term is a parametric proof of reflexivity for ``R`` if it has type -``forall (x1 :T1 ) ... (xn :Tn), reflexive (R x1 ... xn )``. +``forall (x1 : T1) ... (xn : Tn), reflexive (R x1 ... xn)``. Similar definitions are given for parametric proofs of symmetry and transitivity. -**Example 2 (Parametric relation (cont.)):** +.. example:: Parametric relation (continued) -The ``set_eq`` relation of the previous example can be proved to be -reflexive, symmetric and transitive. A parametric unary function ``f`` of type -``forall (x1 :T1 ) ... (xn :Tn ), A1 -> A2`` covariantly respects two parametric relation instances -``R1`` and ``R2`` if, whenever ``x``, ``y`` satisfy ``R1 x y``, their images (``f x``) and (``f y``) -satisfy ``R2 (f x) (f y)``. An ``f`` that respects its input and output -relations will be called a unary covariant *morphism*. We can also say -that ``f`` is a monotone function with respect to ``R1`` and ``R2`` . The -sequence ``x1 ... xn`` represents the parameters of the morphism. + The ``set_eq`` relation of the previous example can be proved to be + reflexive, symmetric and transitive. A parametric unary function ``f`` of type + ``forall (x1 : T1) ... (xn : Tn), A1 -> A2`` covariantly respects two parametric relation instances + ``R1`` and ``R2`` if, whenever ``x``, ``y`` satisfy ``R1 x y``, their images (``f x``) and (``f y``) + satisfy ``R2 (f x) (f y)``. An ``f`` that respects its input and output + relations will be called a unary covariant *morphism*. We can also say + that ``f`` is a monotone function with respect to ``R1`` and ``R2`` . The + sequence ``x1 ... xn`` represents the parameters of the morphism. Let ``R1`` and ``R2`` be two parametric relations. The *signature* of a -parametric morphism of type ``forall (x1 :T1 ) ... (xn :Tn ), A1 -> A2`` +parametric morphism of type ``forall (x1 : T1) ... (xn : Tn), A1 -> A2`` that covariantly respects two instances :math:`I_{R_1}` and :math:`I_{R_2}` of ``R1`` and ``R2`` is written :math:`I_{R_1} ++> I_{R_2}`. Notice that the special arrow ++>, which reminds the reader of covariance, is placed between the two relation @@ -118,29 +117,29 @@ covariant and contravariant. An instance of a parametric morphism :math:`f` with :math:`n` parameters is any term :math:`f \, t_1 \ldots t_n`. -**Example 3 (Morphisms):** +.. example:: Morphisms -Continuing the previous example, let ``union: forall (A: Type), list A -> list A -> list A`` -perform the union of two sets by appending one list to the other. ``union` is a binary -morphism parametric over ``A`` that respects the relation instance -``(set_eq A)``. The latter condition is proved by showing: + Continuing the previous example, let ``union: forall (A : Type), list A -> list A -> list A`` + perform the union of two sets by appending one list to the other. ``union` is a binary + morphism parametric over ``A`` that respects the relation instance + ``(set_eq A)``. The latter condition is proved by showing: -.. coqtop:: in + .. coqtop:: in - forall (A: Type) (S1 S1’ S2 S2’: list A), - set_eq A S1 S1’ -> - set_eq A S2 S2’ -> - set_eq A (union A S1 S2) (union A S1’ S2’). + forall (A : Type) (S1 S1’ S2 S2’ : list A), + set_eq A S1 S1’ -> + set_eq A S2 S2’ -> + set_eq A (union A S1 S2) (union A S1’ S2’). -The signature of the function ``union A`` is ``set_eq A ==> set_eq A ==> set_eq A`` -for all ``A``. + The signature of the function ``union A`` is ``set_eq A ==> set_eq A ==> set_eq A`` + for all ``A``. -**Example 4 (Contravariant morphism):** +.. example:: Contravariant morphisms -The division function ``Rdiv: R -> R -> R`` is a morphism of signature -``le ++> le --> le`` where ``le`` is the usual order relation over -real numbers. Notice that division is covariant in its first argument -and contravariant in its second argument. + The division function ``Rdiv : R -> R -> R`` is a morphism of signature + ``le ++> le --> le`` where ``le`` is the usual order relation over + real numbers. Notice that division is covariant in its first argument + and contravariant in its second argument. Leibniz equality is a relation and every function is a morphism that respects Leibniz equality. Unfortunately, Leibniz equality is not @@ -149,180 +148,178 @@ always the intended equality for a given structure. In the next section we will describe the commands to register terms as parametric relations and morphisms. Several tactics that deal with equality in Coq can also work with the registered relations. The exact -list of tactic will be given :ref:`in this section <tactics-enabled-on-user-provided-relations>`. -For instance, the tactic reflexivity can be used to close a goal ``R n n`` whenever ``R`` +list of tactics will be given :ref:`in this section <tactics-enabled-on-user-provided-relations>`. +For instance, the tactic reflexivity can be used to solve a goal ``R n n`` whenever ``R`` is an instance of a registered reflexive relation. However, the tactics that replace in a context ``C[]`` one term with another one related by ``R`` must verify that ``C[]`` is a morphism that respects the -intended relation. Currently the verification consists in checking +intended relation. Currently the verification consists of checking whether ``C[]`` is a syntactic composition of morphism instances that respects some obvious compatibility constraints. +.. example:: Rewriting -**Example 5 (Rewriting):** - -Continuing the previous examples, suppose that the user must prove -``set_eq int (union int (union int S1 S2) S2) (f S1 S2)`` under the -hypothesis ``H: set_eq int S2 (@nil int)``. It -is possible to use the ``rewrite`` tactic to replace the first two -occurrences of ``S2`` with ``@nil int`` in the goal since the -context ``set_eq int (union int (union int S1 nil) nil) (f S1 S2)``, -being a composition of morphisms instances, is a morphism. However the -tactic will fail replacing the third occurrence of ``S2`` unless ``f`` -has also been declared as a morphism. + Continuing the previous examples, suppose that the user must prove + ``set_eq int (union int (union int S1 S2) S2) (f S1 S2)`` under the + hypothesis ``H : set_eq int S2 (@nil int)``. It + is possible to use the ``rewrite`` tactic to replace the first two + occurrences of ``S2`` with ``@nil int`` in the goal since the + context ``set_eq int (union int (union int S1 nil) nil) (f S1 S2)``, + being a composition of morphisms instances, is a morphism. However the + tactic will fail replacing the third occurrence of ``S2`` unless ``f`` + has also been declared as a morphism. Adding new relations and morphisms ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A parametric relation :g:`Aeq: forall (y1 : β1 ... ym : βm )`, -:g:`relation (A t1 ... tn)` over :g:`(A : αi -> ... αn -> Type)` can be -declared with the following command: +.. cmd:: Add Parametric Relation (x1 : T1) ... (xn : Tk) : (A t1 ... tn) (Aeq t′1 ... t′m) {? reflexivity proved by refl} {? symmetry proved by sym} {? transitivity proved by trans} as @ident -.. cmd:: Add Parametric Relation (x1 : T1) ... (xn : Tk) : (A t1 ... tn) (Aeq t′1 ... t′m ) {? reflexivity proved by refl} {? symmetry proved by sym} {? transitivity proved by trans} as @ident - -after having required the ``Setoid`` module with the ``Require Setoid`` -command. + This command declares a parametric relation :g:`Aeq: forall (y1 : β1 ... ym : βm)`, + :g:`relation (A t1 ... tn)` over :g:`(A : αi -> ... αn -> Type)`. -The :g:`@ident` gives a unique name to the morphism and it is used -by the command to generate fresh names for automatically provided -lemmas used internally. + The :token:`ident` gives a unique name to the morphism and it is used + by the command to generate fresh names for automatically provided + lemmas used internally. -Notice that the carrier and relation parameters may refer to the -context of variables introduced at the beginning of the declaration, -but the instances need not be made only of variables. Also notice that -``A`` is *not* required to be a term having the same parameters as ``Aeq``, -although that is often the case in practice (this departs from the -previous implementation). + Notice that the carrier and relation parameters may refer to the + context of variables introduced at the beginning of the declaration, + but the instances need not be made only of variables. Also notice that + ``A`` is *not* required to be a term having the same parameters as ``Aeq``, + although that is often the case in practice (this departs from the + previous implementation). + To use this command, you need to first import the module ``Setoid`` using + the command ``Require Import Setoid``. .. cmd:: Add Relation -In case the carrier and relations are not parametric, one can use this command -instead, whose syntax is the same except there is no local context. + In case the carrier and relations are not parametric, one can use this command + instead, whose syntax is the same except there is no local context. -The proofs of reflexivity, symmetry and transitivity can be omitted if -the relation is not an equivalence relation. The proofs must be -instances of the corresponding relation definitions: e.g. the proof of -reflexivity must have a type convertible to -:g:`reflexive (A t1 ... tn) (Aeq t′ 1 …t′ n )`. -Each proof may refer to the introduced variables as well. + The proofs of reflexivity, symmetry and transitivity can be omitted if + the relation is not an equivalence relation. The proofs must be + instances of the corresponding relation definitions: e.g. the proof of + reflexivity must have a type convertible to + :g:`reflexive (A t1 ... tn) (Aeq t′ 1 …t′ n)`. + Each proof may refer to the introduced variables as well. -**Example 6 (Parametric relation):** +.. example:: Parametric relation -For Leibniz equality, we may declare: + For Leibniz equality, we may declare: -.. coqtop:: in + .. coqtop:: in - Add Parametric Relation (A : Type) : A (@eq A) - [reflexivity proved by @refl_equal A] - ... + Add Parametric Relation (A : Type) : A (@eq A) + [reflexivity proved by @refl_equal A] + ... Some tactics (:tacn:`reflexivity`, :tacn:`symmetry`, :tacn:`transitivity`) work only on relations that respect the expected properties. The remaining tactics -(`replace`, :tacn:`rewrite` and derived tactics such as :tacn:`autorewrite`) do not +(:tacn:`replace`, :tacn:`rewrite` and derived tactics such as :tacn:`autorewrite`) do not require any properties over the relation. However, they are able to replace terms with related ones only in contexts that are syntactic compositions of parametric morphism instances declared with the following command. -.. cmd:: Add Parametric Morphism (x1 : T1 ) ... (xk : Tk ) : (f t1 ... tn ) with signature sig as @ident +.. cmd:: Add Parametric Morphism (x1 : T1) ... (xk : Tk) : (f t1 ... tn) with signature sig as @ident -The command declares ``f`` as a parametric morphism of signature ``sig``. The -identifier ``id`` gives a unique name to the morphism and it is used as -the base name of the type class instance definition and as the name of -the lemma that proves the well-definedness of the morphism. The -parameters of the morphism as well as the signature may refer to the -context of variables. The command asks the user to prove interactively -that ``f`` respects the relations identified from the signature. + This command declares ``f`` as a parametric morphism of signature ``sig``. The + identifier :token:`ident` gives a unique name to the morphism and it is used as + the base name of the typeclass instance definition and as the name of + the lemma that proves the well-definedness of the morphism. The + parameters of the morphism as well as the signature may refer to the + context of variables. The command asks the user to prove interactively + that ``f`` respects the relations identified from the signature. -**Example 7:** +.. example:: -We start the example by assuming a small theory over -homogeneous sets and we declare set equality as a parametric -equivalence relation and union of two sets as a parametric morphism. + We start the example by assuming a small theory over + homogeneous sets and we declare set equality as a parametric + equivalence relation and union of two sets as a parametric morphism. -.. coqtop:: in + .. coqtop:: in - Require Export Setoid. - Require Export Relation_Definitions. + Require Export Setoid. + Require Export Relation_Definitions. - Set Implicit Arguments. + Set Implicit Arguments. - Parameter set: Type -> Type. - Parameter empty: forall A, set A. - Parameter eq_set: forall A, set A -> set A -> Prop. - Parameter union: forall A, set A -> set A -> set A. + Parameter set : Type -> Type. + Parameter empty : forall A, set A. + Parameter eq_set : forall A, set A -> set A -> Prop. + Parameter union : forall A, set A -> set A -> set A. - Axiom eq_set_refl: forall A, reflexive _ (eq_set (A:=A)). - Axiom eq_set_sym: forall A, symmetric _ (eq_set (A:=A)). - Axiom eq_set_trans: forall A, transitive _ (eq_set (A:=A)). - Axiom empty_neutral: forall A (S: set A), eq_set (union S (empty A)) S. + Axiom eq_set_refl : forall A, reflexive _ (eq_set (A:=A)). + Axiom eq_set_sym : forall A, symmetric _ (eq_set (A:=A)). + Axiom eq_set_trans : forall A, transitive _ (eq_set (A:=A)). + Axiom empty_neutral : forall A (S : set A), eq_set (union S (empty A)) S. - Axiom union_compat: forall (A : Type), - forall x x' : set A, eq_set x x' -> - forall y y' : set A, eq_set y y' -> - eq_set (union x y) (union x' y'). + Axiom union_compat : + forall (A : Type), + forall x x' : set A, eq_set x x' -> + forall y y' : set A, eq_set y y' -> + eq_set (union x y) (union x' y'). - Add Parametric Relation A : (set A) (@eq_set A) - reflexivity proved by (eq_set_refl (A:=A)) - symmetry proved by (eq_set_sym (A:=A)) - transitivity proved by (eq_set_trans (A:=A)) - as eq_set_rel. + Add Parametric Relation A : (set A) (@eq_set A) + reflexivity proved by (eq_set_refl (A:=A)) + symmetry proved by (eq_set_sym (A:=A)) + transitivity proved by (eq_set_trans (A:=A)) + as eq_set_rel. - Add Parametric Morphism A : (@union A) with - signature (@eq_set A) ==> (@eq_set A) ==> (@eq_set A) as union_mor. - Proof. - exact (@union_compat A). - Qed. + Add Parametric Morphism A : (@union A) + with signature (@eq_set A) ==> (@eq_set A) ==> (@eq_set A) as union_mor. + Proof. + exact (@union_compat A). + Qed. -It is possible to reduce the burden of specifying parameters using -(maximally inserted) implicit arguments. If ``A`` is always set as -maximally implicit in the previous example, one can write: + It is possible to reduce the burden of specifying parameters using + (maximally inserted) implicit arguments. If ``A`` is always set as + maximally implicit in the previous example, one can write: -.. coqtop:: in + .. coqtop:: in - Add Parametric Relation A : (set A) eq_set - reflexivity proved by eq_set_refl - symmetry proved by eq_set_sym - transitivity proved by eq_set_trans - as eq_set_rel. + Add Parametric Relation A : (set A) eq_set + reflexivity proved by eq_set_refl + symmetry proved by eq_set_sym + transitivity proved by eq_set_trans + as eq_set_rel. -.. coqtop:: in + .. coqtop:: in - Add Parametric Morphism A : (@union A) with - signature eq_set ==> eq_set ==> eq_set as union_mor. + Add Parametric Morphism A : (@union A) with + signature eq_set ==> eq_set ==> eq_set as union_mor. -.. coqtop:: in + .. coqtop:: in - Proof. exact (@union_compat A). Qed. + Proof. exact (@union_compat A). Qed. -We proceed now by proving a simple lemma performing a rewrite step and -then applying reflexivity, as we would do working with Leibniz -equality. Both tactic applications are accepted since the required -properties over ``eq_set`` and ``union`` can be established from the two -declarations above. + We proceed now by proving a simple lemma performing a rewrite step and + then applying reflexivity, as we would do working with Leibniz + equality. Both tactic applications are accepted since the required + properties over ``eq_set`` and ``union`` can be established from the two + declarations above. -.. coqtop:: in + .. coqtop:: in - Goal forall (S: set nat), - eq_set (union (union S empty) S) (union S S). + Goal forall (S : set nat), + eq_set (union (union S empty) S) (union S S). -.. coqtop:: in + .. coqtop:: in - Proof. intros. rewrite empty_neutral. reflexivity. Qed. + Proof. intros. rewrite empty_neutral. reflexivity. Qed. -The tables of relations and morphisms are managed by the type class -instance mechanism. The behavior on section close is to generalize the -instances by the variables of the section (and possibly hypotheses -used in the proofs of instance declarations) but not to export them in -the rest of the development for proof search. One can use the -cmd:`Existing Instance` command to do so outside the section, using the name of the -declared morphism suffixed by ``_Morphism``, or use the ``Global`` modifier -for the corresponding class instance declaration -(see :ref:`First Class Setoids and Morphisms <first-class-setoids-and-morphisms>`) at -definition time. When loading a compiled file or importing a module, -all the declarations of this module will be loaded. + The tables of relations and morphisms are managed by the typeclass + instance mechanism. The behavior on section close is to generalize the + instances by the variables of the section (and possibly hypotheses + used in the proofs of instance declarations) but not to export them in + the rest of the development for proof search. One can use the + cmd:`Existing Instance` command to do so outside the section, using the name of the + declared morphism suffixed by ``_Morphism``, or use the ``Global`` modifier + for the corresponding class instance declaration + (see :ref:`First Class Setoids and Morphisms <first-class-setoids-and-morphisms>`) at + definition time. When loading a compiled file or importing a module, + all the declarations of this module will be loaded. Rewriting and non reflexive relations @@ -332,31 +329,31 @@ To replace only one argument of an n-ary morphism it is necessary to prove that all the other arguments are related to themselves by the respective relation instances. -**Example 8:** +.. example:: -To replace ``(union S empty)`` with ``S`` in ``(union (union S empty) S) (union S S)`` -the rewrite tactic must exploit the monotony of ``union`` (axiom ``union_compat`` -in the previous example). Applying ``union_compat`` by hand we are left with the -goal ``eq_set (union S S) (union S S)``. + To replace ``(union S empty)`` with ``S`` in ``(union (union S empty) S) (union S S)`` + the rewrite tactic must exploit the monotony of ``union`` (axiom ``union_compat`` + in the previous example). Applying ``union_compat`` by hand we are left with the + goal ``eq_set (union S S) (union S S)``. When the relations associated to some arguments are not reflexive, the tactic cannot automatically prove the reflexivity goals, that are left to the user. -Setoids whose relation are partial equivalence relations (PER) are -useful to deal with partial functions. Let ``R`` be a PER. We say that an +Setoids whose relations are partial equivalence relations (PER) are +useful for dealing with partial functions. Let ``R`` be a PER. We say that an element ``x`` is defined if ``R x x``. A partial function whose domain -comprises all the defined elements only is declared as a morphism that +comprises all the defined elements is declared as a morphism that respects ``R``. Every time a rewriting step is performed the user must prove that the argument of the morphism is defined. -**Example 9:** +.. example:: -Let ``eqO`` be ``fun x y => x = y /\ x <> 0`` (the -smaller PER over non zero elements). Division can be declared as a -morphism of signature ``eq ==> eq0 ==> eq``. Replace ``x`` with -``y`` in ``div x n = div y n`` opens the additional goal ``eq0 n n`` -that is equivalent to ``n = n /\ n <> 0``. + Let ``eqO`` be ``fun x y => x = y /\ x <> 0`` (the + smallest PER over nonzero elements). Division can be declared as a + morphism of signature ``eq ==> eq0 ==> eq``. Replacing ``x`` with + ``y`` in ``div x n = div y n`` opens an additional goal ``eq0 n n`` + which is equivalent to ``n = n /\ n <> 0``. Rewriting and non symmetric relations @@ -371,44 +368,44 @@ a contravariant position. In a similar way, replacement in an hypothesis can be performed only if the replaced term occurs in a covariant position. -**Example 10 (Covariance and contravariance):** - -Suppose that division over real numbers has been defined as a morphism of signature -``Z.div: Z.lt ++> Z.lt --> Z.lt`` (i.e. ``Z.div`` is increasing in -its first argument, but decreasing on the second one). Let ``<`` -denotes ``Z.lt``. Under the hypothesis ``H: x < y`` we have -``k < x / y -> k < x / x``, but not ``k < y / x -> k < x / x``. Dually, -under the same hypothesis ``k < x / y -> k < y / y`` holds, but -``k < y / x -> k < y / y`` does not. Thus, if the current goal is -``k < x / x``, it is possible to replace only the second occurrence of -``x`` (in contravariant position) with ``y`` since the obtained goal -must imply the current one. On the contrary, if ``k < x / x`` is an -hypothesis, it is possible to replace only the first occurrence of -``x`` (in covariant position) with ``y`` since the current -hypothesis must imply the obtained one. - -Contrary to the previous implementation, no specific error message -will be raised when trying to replace a term that occurs in the wrong -position. It will only fail because the rewriting constraints are not -satisfiable. However it is possible to use the at modifier to specify -which occurrences should be rewritten. - -As expected, composing morphisms together propagates the variance -annotations by switching the variance every time a contravariant -position is traversed. - -**Example 11:** - -Let us continue the previous example and let us consider -the goal ``x / (x / x) < k``. The first and third occurrences of -``x`` are in a contravariant position, while the second one is in -covariant position. More in detail, the second occurrence of ``x`` -occurs covariantly in ``(x / x)`` (since division is covariant in -its first argument), and thus contravariantly in ``x / (x / x)`` -(since division is contravariant in its second argument), and finally -covariantly in ``x / (x / x) < k`` (since ``<``, as every -transitive relation, is contravariant in its first argument with -respect to the relation itself). +.. example:: Covariance and contravariance + + Suppose that division over real numbers has been defined as a morphism of signature + ``Z.div : Z.lt ++> Z.lt --> Z.lt`` (i.e. ``Z.div`` is increasing in + its first argument, but decreasing on the second one). Let ``<`` + denote ``Z.lt``. Under the hypothesis ``H : x < y`` we have + ``k < x / y -> k < x / x``, but not ``k < y / x -> k < x / x``. Dually, + under the same hypothesis ``k < x / y -> k < y / y`` holds, but + ``k < y / x -> k < y / y`` does not. Thus, if the current goal is + ``k < x / x``, it is possible to replace only the second occurrence of + ``x`` (in contravariant position) with ``y`` since the obtained goal + must imply the current one. On the contrary, if ``k < x / x`` is an + hypothesis, it is possible to replace only the first occurrence of + ``x`` (in covariant position) with ``y`` since the current + hypothesis must imply the obtained one. + + Contrary to the previous implementation, no specific error message + will be raised when trying to replace a term that occurs in the wrong + position. It will only fail because the rewriting constraints are not + satisfiable. However it is possible to use the at modifier to specify + which occurrences should be rewritten. + + As expected, composing morphisms together propagates the variance + annotations by switching the variance every time a contravariant + position is traversed. + +.. example:: + + Let us continue the previous example and let us consider + the goal ``x / (x / x) < k``. The first and third occurrences of + ``x`` are in a contravariant position, while the second one is in + covariant position. More in detail, the second occurrence of ``x`` + occurs covariantly in ``(x / x)`` (since division is covariant in + its first argument), and thus contravariantly in ``x / (x / x)`` + (since division is contravariant in its second argument), and finally + covariantly in ``x / (x / x) < k`` (since ``<``, as every + transitive relation, is contravariant in its first argument with + respect to the relation itself). Rewriting in ambiguous setoid contexts @@ -417,15 +414,14 @@ Rewriting in ambiguous setoid contexts One function can respect several different relations and thus it can be declared as a morphism having multiple signatures. -**Example 12:** - +.. example:: -Union over homogeneous lists can be given all the -following signatures: ``eq ==> eq ==> eq`` (``eq`` being the -equality over ordered lists) ``set_eq ==> set_eq ==> set_eq`` -(``set_eq`` being the equality over unordered lists up to duplicates), -``multiset_eq ==> multiset_eq ==> multiset_eq`` (``multiset_eq`` -being the equality over unordered lists). + Union over homogeneous lists can be given all the + following signatures: ``eq ==> eq ==> eq`` (``eq`` being the + equality over ordered lists) ``set_eq ==> set_eq ==> set_eq`` + (``set_eq`` being the equality over unordered lists up to duplicates), + ``multiset_eq ==> multiset_eq ==> multiset_eq`` (``multiset_eq`` + being the equality over unordered lists). To declare multiple signatures for a morphism, repeat the :cmd:`Add Morphism` command. @@ -435,7 +431,7 @@ rewrite request is ambiguous, since it is unclear what relations should be used to perform the rewriting. Contrary to the previous implementation, the tactic will always choose the first possible solution to the set of constraints generated by a rewrite and will not -try to find *all* possible solutions to warn the user about. +try to find *all* the possible solutions to warn the user about them. Commands and tactics @@ -450,14 +446,14 @@ First class setoids and morphisms The implementation is based on a first-class representation of -properties of relations and morphisms as type classes. That is, the +properties of relations and morphisms as typeclasses. That is, the various combinations of properties on relations and morphisms are represented as records and instances of theses classes are put in a hint database. For example, the declaration: .. coqtop:: in - Add Parametric Relation (x1 : T1) ... (xn : Tk) : (A t1 ... tn) (Aeq t′1 ... t′m) + Add Parametric Relation (x1 : T1) ... (xn : Tn) : (A t1 ... tn) (Aeq t′1 ... t′m) [reflexivity proved by refl] [symmetry proved by sym] [transitivity proved by trans] @@ -468,7 +464,7 @@ is equivalent to an instance declaration: .. coqtop:: in - Instance (x1 : T1) ... (xn : Tk) => id : @Equivalence (A t1 ... tn) (Aeq t′1 ... t′m) := + Instance (x1 : T1) ... (xn : Tn) => id : @Equivalence (A t1 ... tn) (Aeq t′1 ... t′m) := [Equivalence_Reflexive := refl] [Equivalence_Symmetric := sym] [Equivalence_Transitive := trans]. @@ -476,9 +472,9 @@ is equivalent to an instance declaration: The declaration itself amounts to the definition of an object of the record type ``Coq.Classes.RelationClasses.Equivalence`` and a hint added to the ``typeclass_instances`` hint database. Morphism declarations are -also instances of a type class defined in ``Classes.Morphisms``. See the -documentation on type classes :ref:`typeclasses` -and the theories files in Classes for further explanations. +also instances of a typeclass defined in ``Classes.Morphisms``. See the +documentation on :ref:`typeclasses` and the theories files in Classes +for further explanations. One can inform the rewrite tactic about morphisms and relations just by using the typeclass mechanism to declare them using Instance and @@ -491,37 +487,37 @@ handled by encoding them as records. In the following example, the projections of the setoid relation and of the morphism function can be registered as parametric relations and morphisms. -**Example 13 (First class setoids):** +.. example:: First class setoids -.. coqtop:: in + .. coqtop:: in - Require Import Relation_Definitions Setoid. + Require Import Relation_Definitions Setoid. - Record Setoid: Type := - { car: Type; - eq: car -> car -> Prop; - refl: reflexive _ eq; - sym: symmetric _ eq; - trans: transitive _ eq - }. + Record Setoid : Type := + { car: Type; + eq: car -> car -> Prop; + refl: reflexive _ eq; + sym: symmetric _ eq; + trans: transitive _ eq + }. - Add Parametric Relation (s : Setoid) : (@car s) (@eq s) - reflexivity proved by (refl s) - symmetry proved by (sym s) - transitivity proved by (trans s) as eq_rel. + Add Parametric Relation (s : Setoid) : (@car s) (@eq s) + reflexivity proved by (refl s) + symmetry proved by (sym s) + transitivity proved by (trans s) as eq_rel. - Record Morphism (S1 S2:Setoid): Type := - { f: car S1 -> car S2; - compat: forall (x1 x2: car S1), eq S1 x1 x2 -> eq S2 (f x1) (f x2) - }. + Record Morphism (S1 S2 : Setoid) : Type := + { f: car S1 -> car S2; + compat: forall (x1 x2 : car S1), eq S1 x1 x2 -> eq S2 (f x1) (f x2) + }. - Add Parametric Morphism (S1 S2 : Setoid) (M : Morphism S1 S2) : - (@f S1 S2 M) with signature (@eq S1 ==> @eq S2) as apply_mor. - Proof. apply (compat S1 S2 M). Qed. + Add Parametric Morphism (S1 S2 : Setoid) (M : Morphism S1 S2) : + (@f S1 S2 M) with signature (@eq S1 ==> @eq S2) as apply_mor. + Proof. apply (compat S1 S2 M). Qed. - Lemma test: forall (S1 S2:Setoid) (m: Morphism S1 S2) - (x y: car S1), eq S1 x y -> eq S2 (f _ _ m x) (f _ _ m y). - Proof. intros. rewrite H. reflexivity. Qed. + Lemma test : forall (S1 S2 : Setoid) (m : Morphism S1 S2) + (x y : car S1), eq S1 x y -> eq S2 (f _ _ m x) (f _ _ m y). + Proof. intros. rewrite H. reflexivity. Qed. .. _tactics-enabled-on-user-provided-relations: @@ -539,33 +535,32 @@ pass additional arguments such as ``using relation``. .. tacv:: setoid_reflexivity :name: setoid_reflexivity -.. tacv:: setoid_symmetry [in @ident] +.. tacv:: setoid_symmetry {? in @ident} :name: setoid_symmetry .. tacv:: setoid_transitivity :name: setoid_transitivity -.. tacv:: setoid_rewrite [@orientation] @term [at @occs] [in @ident] +.. tacv:: setoid_rewrite {? @orientation} @term {? at @occs} {? in @ident} :name: setoid_rewrite -.. tacv:: setoid_replace @term with @term [in @ident] [using relation @term] [by @tactic] +.. tacv:: setoid_replace @term with @term {? using relation @term} {? in @ident} {? by @tactic} :name: setoid_replace - -The ``using relation`` arguments cannot be passed to the unprefixed form. -The latter argument tells the tactic what parametric relation should -be used to replace the first tactic argument with the second one. If -omitted, it defaults to the ``DefaultRelation`` instance on the type of -the objects. By default, it means the most recent ``Equivalence`` instance -in the environment, but it can be customized by declaring -new ``DefaultRelation`` instances. As Leibniz equality is a declared -equivalence, it will fall back to it if no other relation is declared -on a given type. + The ``using relation`` arguments cannot be passed to the unprefixed form. + The latter argument tells the tactic what parametric relation should + be used to replace the first tactic argument with the second one. If + omitted, it defaults to the ``DefaultRelation`` instance on the type of + the objects. By default, it means the most recent ``Equivalence`` instance + in the environment, but it can be customized by declaring + new ``DefaultRelation`` instances. As Leibniz equality is a declared + equivalence, it will fall back to it if no other relation is declared + on a given type. Every derived tactic that is based on the unprefixed forms of the tactics considered above will also work up to user defined relations. For instance, it is possible to register hints for :tacn:`autorewrite` that -are not proof of Leibniz equalities. In particular it is possible to +are not proofs of Leibniz equalities. In particular it is possible to exploit :tacn:`autorewrite` to simulate normalization in a term rewriting system up to user defined equalities. @@ -575,39 +570,39 @@ Printing relations and morphisms .. cmd:: Print Instances -This command can be used to show the list of currently -registered ``Reflexive`` (using ``Print Instances Reflexive``), ``Symmetric`` -or ``Transitive`` relations, Equivalences, PreOrders, PERs, and Morphisms -(implemented as ``Proper`` instances). When the rewriting tactics refuse -to replace a term in a context because the latter is not a composition -of morphisms, the :cmd:`Print Instances` command can be useful to understand -what additional morphisms should be registered. + This command can be used to show the list of currently + registered ``Reflexive`` (using ``Print Instances Reflexive``), ``Symmetric`` + or ``Transitive`` relations, Equivalences, PreOrders, PERs, and Morphisms + (implemented as ``Proper`` instances). When the rewriting tactics refuse + to replace a term in a context because the latter is not a composition + of morphisms, the :cmd:`Print Instances` command can be useful to understand + what additional morphisms should be registered. Deprecated syntax and backward incompatibilities ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Due to backward compatibility reasons, the following syntax for the -declaration of setoids and morphisms is also accepted. - .. cmd:: Add Setoid @A @Aeq @ST as @ident -where ``Aeq`` is a congruence relation without parameters, ``A`` is its carrier -and ``ST`` is an object of type (``Setoid_Theory A Aeq``) (i.e. a record -packing together the reflexivity, symmetry and transitivity lemmas). -Notice that the syntax is not completely backward compatible since the -identifier was not required. + This command for declaring setoids and morphisms is also accepted due + to backward compatibility reasons. + + Here ``Aeq`` is a congruence relation without parameters, ``A`` is its carrier + and ``ST`` is an object of type (``Setoid_Theory A Aeq``) (i.e. a record + packing together the reflexivity, symmetry and transitivity lemmas). + Notice that the syntax is not completely backward compatible since the + identifier was not required. .. cmd:: Add Morphism f : @ident :name: Add Morphism -The latter command also is restricted to the declaration of morphisms -without parameters. It is not fully backward compatible since the -property the user is asked to prove is slightly different: for n-ary -morphisms the hypotheses of the property are permuted; moreover, when -the morphism returns a proposition, the property is now stated using a -bi-implication in place of a simple implication. In practice, porting -an old development to the new semantics is usually quite simple. + This command is restricted to the declaration of morphisms + without parameters. It is not fully backward compatible since the + property the user is asked to prove is slightly different: for n-ary + morphisms the hypotheses of the property are permuted; moreover, when + the morphism returns a proposition, the property is now stated using a + bi-implication in place of a simple implication. In practice, porting + an old development to the new semantics is usually quite simple. Notice that several limitations of the old implementation have been lifted. In particular, it is now possible to declare several relations @@ -657,9 +652,8 @@ in ``Prop`` are implicitly translated to such applications). Indeed, when rewriting under a lambda, binding variable ``x``, say from ``P x`` to ``Q x`` using the relation iff, the tactic will generate a proof of ``pointwise_relation A iff (fun x => P x) (fun x => Q x)`` from the proof -of ``iff (P x) (Q x)`` and a constraint of the form Proper -``(pointwise_relation A iff ==> ?) m`` will be generated for the -surrounding morphism ``m``. +of ``iff (P x) (Q x)`` and a constraint of the form ``Proper (pointwise_relation A iff ==> ?) m`` +will be generated for the surrounding morphism ``m``. Hence, one can add higher-order combinators as morphisms by providing signatures using pointwise extension for the relations on the @@ -685,11 +679,11 @@ default. The semantics of the previous :tacn:`setoid_rewrite` implementation can almost be recovered using the ``at 1`` modifier. -Sub-relations +Subrelations ~~~~~~~~~~~~~ -Sub-relations can be used to specify that one relation is included in -another, so that morphisms signatures for one can be used for the +Subrelations can be used to specify that one relation is included in +another, so that morphism signatures for one can be used for the other. If a signature mentions a relation ``R`` on the left of an arrow ``==>``, then the signature also applies for any relation ``S`` that is smaller than ``R``, and the inverse applies on the right of an arrow. One @@ -702,14 +696,14 @@ two morphisms for conjunction: ``Proper (impl ==> impl ==> impl) and`` and rewriting constraints arising from a rewrite using ``iff``, ``impl`` or ``inverse impl`` through ``and``. -Sub-relations are implemented in ``Classes.Morphisms`` and are a prime +Subrelations are implemented in ``Classes.Morphisms`` and are a prime example of a mostly user-space extension of the algorithm. Constant unfolding ~~~~~~~~~~~~~~~~~~ -The resolution tactic is based on type classes and hence regards user- +The resolution tactic is based on typeclasses and hence regards user- defined constants as transparent by default. This may slow down the resolution due to a lot of unifications (all the declared ``Proper`` instances are tried at each node of the search tree). To speed it up, diff --git a/doc/sphinx/addendum/implicit-coercions.rst b/doc/sphinx/addendum/implicit-coercions.rst index 09faa06765..c0c4539564 100644 --- a/doc/sphinx/addendum/implicit-coercions.rst +++ b/doc/sphinx/addendum/implicit-coercions.rst @@ -31,7 +31,7 @@ A class with `n` parameters is any defined name with a type :g:`forall (x₁:A₁)..(xₙ:Aₙ),s` where ``s`` is a sort. Thus a class with parameters is considered as a single class and not as a family of classes. An object of a class ``C`` is any term of type :g:`C t₁ .. tₙ`. -In addition to these user-classes, we have two abstract classes: +In addition to these user-defined classes, we have two built-in classes: * ``Sortclass``, the class of sorts; its objects are the terms whose type is a @@ -50,11 +50,11 @@ Formally, the syntax of a classes is defined as: Coercions --------- -A name ``f`` can be declared as a coercion between a source user-class +A name ``f`` can be declared as a coercion between a source user-defined class ``C`` with `n` parameters and a target class ``D`` if one of these conditions holds: - * ``D`` is a user-class, then the type of ``f`` must have the form + * ``D`` is a user-defined class, then the type of ``f`` must have the form :g:`forall (x₁:A₁)..(xₙ:Aₙ)(y:C x₁..xₙ), D u₁..uₘ` where `m` is the number of parameters of ``D``. * ``D`` is ``Funclass``, then the type of ``f`` must have the form @@ -65,8 +65,8 @@ conditions holds: We then write :g:`f : C >-> D`. The restriction on the type of coercions is called *the uniform inheritance condition*. -.. note:: The abstract class ``Sortclass`` can be used as a source class, but - the abstract class ``Funclass`` cannot. +.. note:: The built-in class ``Sortclass`` can be used as a source class, but + the built-in class ``Funclass`` cannot. To coerce an object :g:`t:C t₁..tₙ` of ``C`` towards ``D``, we have to apply the coercion ``f`` to it; the obtained term :g:`f t₁..tₙ t` is @@ -95,7 +95,7 @@ We can now declare ``f`` as coercion from ``C'`` to ``D``, since we can The identity coercions have a special status: to coerce an object :g:`t:C' t₁..tₖ` -of ``C'`` towards ``C``, we does not have to insert explicitly ``Id_C'_C`` +of ``C'`` towards ``C``, we do not have to insert explicitly ``Id_C'_C`` since :g:`Id_C'_C t₁..tₖ t` is convertible with ``t``. However we "rewrite" the type of ``t`` to become an object of ``C``; in this case, it becomes :g:`C uₙ'..uₖ'` where each ``uᵢ'`` is the result of the @@ -121,7 +121,7 @@ by the coercions ``f₁..fₖ``. The application of a coercion path to a term consists of the successive application of its coercions. -Declaration of Coercions +Declaring Coercions ------------------------- .. cmd:: Coercion @qualid : @class >-> @class @@ -140,8 +140,8 @@ Declaration of Coercions .. warn:: Ambiguous path. - When the coercion :token:`qualid` is added to the inheritance graph, non - valid coercion paths are ignored; they are signaled by a warning + When the coercion :token:`qualid` is added to the inheritance graph, + invalid coercion paths are ignored; they are signaled by a warning displaying these paths of the form :g:`[f₁;..;fₙ] : C >-> D`. .. cmdv:: Local Coercion @qualid : @class >-> @class @@ -215,7 +215,7 @@ declaration, this constructor is declared as a coercion. .. cmdv:: Local Identity Coercion @ident : @ident >-> @ident - Idem but locally to the current section. + Same as ``Identity Coercion`` but locally to the current section. .. cmdv:: SubClass @ident := @type :name: SubClass @@ -319,7 +319,7 @@ Coercions and Modules Since |Coq| version 8.3, the coercions present in a module are activated only when the module is explicitly imported. Formerly, the coercions - were activated as soon as the module was required, whatever it was + were activated as soon as the module was required, whether it was imported or not. This option makes it possible to recover the behavior of the versions of @@ -352,7 +352,7 @@ We first give an example of coercion between atomic inductive types .. warning:: - Note that ``Check true=O`` would fail. This is "normal" behaviour of + Note that ``Check true=O`` would fail. This is "normal" behavior of coercions. To validate ``true=O``, the coercion is searched from ``nat`` to ``bool``. There is none. @@ -387,8 +387,8 @@ We give now an example using identity coercions. In the case of functional arguments, we use the monotonic rule of -sub-typing. Approximatively, to coerce :g:`t:forall x:A,B` towards -:g:`forall x:A',B'`, one have to coerce ``A'`` towards ``A`` and ``B`` +sub-typing. To coerce :g:`t : forall x : A, B` towards +:g:`forall x : A', B'`, we have to coerce ``A'`` towards ``A`` and ``B`` towards ``B'``. An example is given below: .. coqtop:: all @@ -424,8 +424,8 @@ replaced by ``x:A'`` where ``A'`` is the result of the application to ``Sortclass`` if it exists. This case occurs in the abstraction :g:`fun x:A => t`, universal quantification :g:`forall x:A,B`, global variables and parameters of (co-)inductive definitions and -functions. In :g:`forall x:A,B`, such a coercion path may be applied -to ``B`` also if necessary. +functions. In :g:`forall x:A,B`, such a coercion path may also be applied +to ``B`` if necessary. .. coqtop:: all diff --git a/doc/sphinx/addendum/micromega.rst b/doc/sphinx/addendum/micromega.rst index 2407a9051a..d03a31c044 100644 --- a/doc/sphinx/addendum/micromega.rst +++ b/doc/sphinx/addendum/micromega.rst @@ -20,7 +20,7 @@ rationals ``Require Import Lqa`` and reals ``Require Import Lra``. + :tacn:`nra` is an incomplete proof procedure for non-linear (real or rational) arithmetic; + :tacn:`psatz` ``D n`` where ``D`` is :math:`\mathbb{Z}` or :math:`\mathbb{Q}` or :math:`\mathbb{R}`, and - ``n`` is an optional integer limiting the proof search depth + ``n`` is an optional integer limiting the proof search depth, is an incomplete proof procedure for non-linear arithmetic. It is based on John Harrison’s HOL Light driver to the external prover `csdp` [#]_. Note that the `csdp` driver is @@ -32,10 +32,10 @@ arithmetic expressions interpreted over a domain :math:`D` ∈ {ℤ, ℚ, ℝ}. The syntax of the formulas is the following: .. productionlist:: `F` - F : A ∣ P ∣ True ∣ False ∣ F 1 ∧ F 2 ∣ F 1 ∨ F 2 ∣ F 1 ↔ F 2 ∣ F 1 → F 2 ∣ ¬ F - A : p 1 = p 2 ∣ p 1 > p 2 ∣ p 1 < p 2 ∣ p 1 ≥ p 2 ∣ p 1 ≤ p 2 - p : c ∣ x ∣ −p ∣ p 1 − p 2 ∣ p 1 + p 2 ∣ p 1 × p 2 ∣ p ^ n - + F : A ∣ P ∣ True ∣ False ∣ F ∧ F ∣ F ∨ F ∣ F ↔ F ∣ F → F ∣ ¬ F + A : p = p ∣ p > p ∣ p < p ∣ p ≥ p ∣ p ≤ p + p : c ∣ x ∣ −p ∣ p − p ∣ p + p ∣ p × p ∣ p ^ n + where :math:`c` is a numeric constant, :math:`x \in D` is a numeric variable, the operators :math:`−, +, ×` are respectively subtraction, addition, and product; :math:`p ^ n` is exponentiation by a constant :math:`n`, :math:`P` is an arbitrary proposition. @@ -81,11 +81,11 @@ If :math:`-1` belongs to :math:`\mathit{Cone}(S)`, then the conjunction A proof based on this theorem is called a *positivstellensatz* refutation. The tactics work as follows. Formulas are normalized into conjunctive normal form :math:`\bigwedge_i C_i` where :math:`C_i` has the -general form :math:`(\bigwedge_{j\in S_i} p_j \Join 0) \to \mathit{False})` and +general form :math:`(\bigwedge_{j\in S_i} p_j \Join 0) \to \mathit{False}` and :math:`\Join \in \{>,\ge,=\}` for :math:`D\in \{\mathbb{Q},\mathbb{R}\}` and :math:`\Join \in \{\ge, =\}` for :math:`\mathbb{Z}`. -For each conjunct :math:`C_i`, the tactic calls a oracle which searches for +For each conjunct :math:`C_i`, the tactic calls an oracle which searches for :math:`-1` within the cone. Upon success, the oracle returns a *cone expression* that is normalized by the ring tactic (see :ref:`theringandfieldtacticfamilies`) and checked to be :math:`-1`. diff --git a/doc/sphinx/addendum/miscellaneous-extensions.rst b/doc/sphinx/addendum/miscellaneous-extensions.rst index b6c35d8fa7..0f2d35d044 100644 --- a/doc/sphinx/addendum/miscellaneous-extensions.rst +++ b/doc/sphinx/addendum/miscellaneous-extensions.rst @@ -32,6 +32,7 @@ When the proof ends two constants are defined: ends with ``Qed``, and transparent if the proof ends with ``Defined``. .. example:: + .. coqtop:: all Require Coq.derive.Derive. diff --git a/doc/sphinx/addendum/nsatz.rst b/doc/sphinx/addendum/nsatz.rst index 387d614956..9adeca46fc 100644 --- a/doc/sphinx/addendum/nsatz.rst +++ b/doc/sphinx/addendum/nsatz.rst @@ -1,63 +1,55 @@ .. include:: ../preamble.rst -.. _nsatz: +.. _nsatz_chapter: Nsatz: tactics for proving equalities in integral domains =========================================================== :Author: Loïc Pottier -The tactic `nsatz` proves goals of the form +.. tacn:: nsatz + :name: nsatz -:math:`\begin{array}{l} -\forall X_1,\ldots,X_n \in A,\\ -P_1(X_1,\ldots,X_n) = Q_1(X_1,\ldots,X_n) , \ldots , P_s(X_1,\ldots,X_n) =Q_s(X_1,\ldots,X_n)\\ -\vdash P(X_1,\ldots,X_n) = Q(X_1,\ldots,X_n)\\ -\end{array}` + This tactic is for solving goals of the form -where :math:`P, Q, P₁,Q₁,\ldots,Pₛ, Qₛ` are polynomials and :math:`A` is an integral -domain, i.e. a commutative ring with no zero divisor. For example, :math:`A` -can be :math:`\mathbb{R}`, :math:`\mathbb{Z}`, or :math:`\mathbb{Q}`. -Note that the equality :math:`=` used in these goals can be -any setoid equality (see :ref:`tactics-enabled-on-user-provided-relations`) , not only Leibnitz equality. + :math:`\begin{array}{l} + \forall X_1, \ldots, X_n \in A, \\ + P_1(X_1, \ldots, X_n) = Q_1(X_1, \ldots, X_n), \ldots, P_s(X_1, \ldots, X_n) = Q_s(X_1, \ldots, X_n) \\ + \vdash P(X_1, \ldots, X_n) = Q(X_1, \ldots, X_n) \\ + \end{array}` -It also proves formulas + where :math:`P, Q, P_1, Q_1, \ldots, P_s, Q_s` are polynomials and :math:`A` is an integral + domain, i.e. a commutative ring with no zero divisors. For example, :math:`A` + can be :math:`\mathbb{R}`, :math:`\mathbb{Z}`, or :math:`\mathbb{Q}`. + Note that the equality :math:`=` used in these goals can be + any setoid equality (see :ref:`tactics-enabled-on-user-provided-relations`) , not only Leibniz equality. -:math:`\begin{array}{l} -\forall X_1,\ldots,X_n \in A,\\ -P_1(X_1,\ldots,X_n) = Q_1(X_1,\ldots,X_n) \wedge \ldots \wedge P_s(X_1,\ldots,X_n) =Q_s(X_1,\ldots,X_n)\\ -\rightarrow P(X_1,\ldots,X_n) = Q(X_1,\ldots,X_n)\\ -\end{array}` + It also proves formulas -doing automatic introductions. + :math:`\begin{array}{l} + \forall X_1, \ldots, X_n \in A, \\ + P_1(X_1, \ldots, X_n) = Q_1(X_1, \ldots, X_n) \wedge \ldots \wedge P_s(X_1, \ldots, X_n) = Q_s(X_1, \ldots, X_n) \\ + \rightarrow P(X_1, \ldots, X_n) = Q(X_1, \ldots, X_n) \\ + \end{array}` + doing automatic introductions. -Using the basic tactic `nsatz` ------------------------------- - - -Load the Nsatz module: - -.. coqtop:: all - - Require Import Nsatz. - -and use the tactic `nsatz`. + You can load the ``Nsatz`` module with the command ``Require Import Nsatz``. More about `nsatz` --------------------- Hilbert’s Nullstellensatz theorem shows how to reduce proofs of -equalities on polynomials on a commutative ring :math:`A` with no zero divisor +equalities on polynomials on a commutative ring :math:`A` with no zero divisors to algebraic computations: it is easy to see that if a polynomial :math:`P` in :math:`A[X_1,\ldots,X_n]` verifies :math:`c P^r = \sum_{i=1}^{s} S_i P_i`, with :math:`c \in A`, :math:`c \not = 0`, :math:`r` a positive integer, and the :math:`S_i` s in :math:`A[X_1,\ldots,X_n ]`, then :math:`P` is zero whenever polynomials :math:`P_1,\ldots,P_s` are zero -(the converse is also true when :math:`A` is an algebraic closed field: the method is +(the converse is also true when :math:`A` is an algebraically closed field: the method is complete). -So, proving our initial problem can reduce into finding :math:`S_1,\ldots,S_s`, +So, solving our initial problem reduces to finding :math:`S_1, \ldots, S_s`, :math:`c` and :math:`r` such that :math:`c (P-Q)^r = \sum_{i} S_i (P_i-Q_i)`, which will be proved by the tactic ring. @@ -68,34 +60,31 @@ Buchberger algorithm. This computation is done after a step of *reification*, which is performed using :ref:`typeclasses`. -The ``Nsatz`` module defines the tactic `nsatz`, which can be used without -arguments, or with the syntax: - -| nsatz with radicalmax:=num%N strategy:=num%Z parameters:= :n:`{* var}` variables:= :n:`{* var}` +.. tacv:: nsatz with radicalmax:=@num%N strategy:=@num%Z parameters:=[{*, @ident}] variables:=[{*, @ident}] -where: + Most complete syntax for `nsatz`. -* `radicalmax` is a bound when for searching r s.t. - :math:`c (P−Q) r = \sum_{i=1..s} S_i (P i − Q i)` + * `radicalmax` is a bound when searching for r such that + :math:`c (P−Q) r = \sum_{i=1..s} S_i (P i − Q i)` -* `strategy` gives the order on variables :math:`X_1,\ldots,X_n` and the strategy - used in Buchberger algorithm (see :cite:`sugar` for details): + * `strategy` gives the order on variables :math:`X_1,\ldots,X_n` and the strategy + used in Buchberger algorithm (see :cite:`sugar` for details): - * strategy = 0: reverse lexicographic order and newest s-polynomial. - * strategy = 1: reverse lexicographic order and sugar strategy. - * strategy = 2: pure lexicographic order and newest s-polynomial. - * strategy = 3: pure lexicographic order and sugar strategy. + * strategy = 0: reverse lexicographic order and newest s-polynomial. + * strategy = 1: reverse lexicographic order and sugar strategy. + * strategy = 2: pure lexicographic order and newest s-polynomial. + * strategy = 3: pure lexicographic order and sugar strategy. -* `parameters` is the list of variables :math:`X_{i_1},\ldots,X_{i_k}` among - :math:`X_1,\ldots,X_n` which are considered as parameters: computation will be performed with - rational fractions in these variables, i.e. polynomials are considered - with coefficients in :math:`R(X_{i_1},\ldots,X_{i_k})`. In this case, the coefficient - :math:`c` can be a non constant polynomial in :math:`X_{i_1},\ldots,X_{i_k}`, and the tactic - produces a goal which states that :math:`c` is not zero. + * `parameters` is the list of variables :math:`X_{i_1},\ldots,X_{i_k}` among + :math:`X_1,\ldots,X_n` which are considered as parameters: computation will be performed with + rational fractions in these variables, i.e. polynomials are considered + with coefficients in :math:`R(X_{i_1},\ldots,X_{i_k})`. In this case, the coefficient + :math:`c` can be a non constant polynomial in :math:`X_{i_1},\ldots,X_{i_k}`, and the tactic + produces a goal which states that :math:`c` is not zero. -* `variables` is the list of the variables in the decreasing order in - which they will be used in Buchberger algorithm. If `variables` = `(@nil R)`, - then `lvar` is replaced by all the variables which are not in - `parameters`. + * `variables` is the list of the variables in the decreasing order in + which they will be used in the Buchberger algorithm. If `variables` = `(@nil R)`, + then `lvar` is replaced by all the variables which are not in + `parameters`. -See file `Nsatz.v` for many examples, especially in geometry. +See the file `Nsatz.v` for many examples, especially in geometry. diff --git a/doc/sphinx/addendum/omega.rst b/doc/sphinx/addendum/omega.rst index 80ce016200..1e92d01125 100644 --- a/doc/sphinx/addendum/omega.rst +++ b/doc/sphinx/addendum/omega.rst @@ -8,23 +8,20 @@ Omega: a solver for quantifier-free problems in Presburger Arithmetic Description of ``omega`` ------------------------ -This tactic does not need any parameter: - .. tacn:: omega -:tacn:`omega` solves a goal in Presburger arithmetic, i.e. a universally -quantified formula made of equations and inequations. Equations may -be specified either on the type ``nat`` of natural numbers or on -the type ``Z`` of binary-encoded integer numbers. Formulas on -``nat`` are automatically injected into ``Z``. The procedure -may use any hypothesis of the current proof session to solve the goal. + :tacn:`omega` is a tactic for solving goals in Presburger arithmetic, + i.e. for proving formulas made of equations and inequalities over the + type ``nat`` of natural numbers or the type ``Z`` of binary-encoded integers. + Formulas on ``nat`` are automatically injected into ``Z``. The procedure + may use any hypothesis of the current proof session to solve the goal. -Multiplication is handled by :tacn:`omega` but only goals where at -least one of the two multiplicands of products is a constant are -solvable. This is the restriction meant by "Presburger arithmetic". + Multiplication is handled by :tacn:`omega` but only goals where at + least one of the two multiplicands of products is a constant are + solvable. This is the restriction meant by "Presburger arithmetic". -If the tactic cannot solve the goal, it fails with an error message. -In any case, the computation eventually stops. + If the tactic cannot solve the goal, it fails with an error message. + In any case, the computation eventually stops. .. tacv:: romega :name: romega @@ -34,8 +31,7 @@ In any case, the computation eventually stops. Arithmetical goals recognized by ``omega`` ------------------------------------------ -:tacn:`omega` applied only to quantifier-free formulas built from the -connectors:: +:tacn:`omega` applies only to quantifier-free formulas built from the connectives:: /\ \/ ~ -> @@ -67,8 +63,8 @@ is generated: universally quantified, try :tacn:`intros` first; if it contains existentials quantifiers too, :tacn:`omega` is not strong enough to solve your goal). This may happen also if your goal contains arithmetical - operators unknown from :tacn:`omega`. Finally, your goal may be really - wrong! + operators not recognized by :tacn:`omega`. Finally, your goal may be simply + not true! .. exn:: omega: Not a quantifier-free goal. @@ -144,12 +140,12 @@ Technical data Overview of the tactic ~~~~~~~~~~~~~~~~~~~~~~ - * The goal is negated twice and the first negation is introduced as an hypothesis. - * Hypothesis are decomposed in simple equations or inequations. Multiple + * The goal is negated twice and the first negation is introduced as a hypothesis. + * Hypotheses are decomposed in simple equations or inequalities. Multiple goals may result from this phase. - * Equations and inequations over ``nat`` are translated over - ``Z``, multiple goals may result from the translation of substraction. - * Equations and inequations are normalized. + * Equations and inequalities over ``nat`` are translated over + ``Z``, multiple goals may result from the translation of subtraction. + * Equations and inequalities are normalized. * Goals are solved by the OMEGA decision procedure. * The script of the solution is replayed. @@ -158,26 +154,25 @@ Overview of the OMEGA decision procedure The OMEGA decision procedure involved in the :tacn:`omega` tactic uses a small subset of the decision procedure presented in :cite:`TheOmegaPaper` -Here is an overview, look at the original paper for more information. +Here is an overview, refer to the original paper for more information. - * Equations and inequations are normalized by division by the GCD of their + * Equations and inequalities are normalized by division by the GCD of their coefficients. * Equations are eliminated, using the Banerjee test to get a coefficient equal to one. - * Note that each inequation defines a half space in the space of real value - of the variables. - * Inequations are solved by projecting on the hyperspace - defined by cancelling one of the variable. They are partitioned + * Note that each inequality cuts the Euclidean space in half. + * Inequalities are solved by projecting on the hyperspace + defined by cancelling one of the variables. They are partitioned according to the sign of the coefficient of the eliminated - variable. Pairs of inequations from different classes define a + variable. Pairs of inequalities from different classes define a new edge in the projection. - * Redundant inequations are eliminated or merged in new + * Redundant inequalities are eliminated or merged in new equations that can be eliminated by the Banerjee test. * The last two steps are iterated until a contradiction is reached (success) or there is no more variable to eliminate (failure). It may happen that there is a real solution and no integer one. The last -steps of the Omega procedure (dark shadow) are not implemented, so the +steps of the Omega procedure are not implemented, so the decision procedure is only partial. Bugs diff --git a/doc/sphinx/addendum/parallel-proof-processing.rst b/doc/sphinx/addendum/parallel-proof-processing.rst index edb8676a5b..8ee8f52227 100644 --- a/doc/sphinx/addendum/parallel-proof-processing.rst +++ b/doc/sphinx/addendum/parallel-proof-processing.rst @@ -68,7 +68,7 @@ to modify the proof script accordingly. Proof blocks and error resilience -------------------------------------- -|Coq| 8.6 introduced a mechanism for error resiliency: in interactive +|Coq| 8.6 introduced a mechanism for error resilience: in interactive mode |Coq| is able to completely check a document containing errors instead of bailing out at the first failure. @@ -92,14 +92,14 @@ Caveats ```````` When a vernacular command fails the subsequent error messages may be -bogus, i.e. caused by the first error. Error resiliency for vernacular +bogus, i.e. caused by the first error. Error resilience for vernacular commands can be switched off by passing ``-async-proofs-command-error-resilience off`` to |CoqIDE|. An incorrect proof block detection can result into an incorrect error recovery and hence in bogus errors. Proof block detection cannot be precise for bullets or any other non well parenthesized proof -structure. Error resiliency can be turned off or selectively activated +structure. Error resilience can be turned off or selectively activated for any set of block kind passing to |CoqIDE| one of the following options: @@ -127,13 +127,14 @@ the very same button, that can also be used to see the list of errors and jump to the corresponding line. If a proof is processed asynchronously the corresponding Qed command -is colored using a lighter color that usual. This signals that the +is colored using a lighter color than usual. This signals that the proof has been delegated to a worker process (or will be processed lazily if the ``-async-proofs lazy`` option is used). Once finished, the worker process will provide the proof object, but this will not be automatically checked by the kernel of the main process. To force the kernel to check all the proof objects, one has to click the button -with the gears. Only then are all the universe constraints checked. +with the gears (Fully check the document) on the top bar. +Only then all the universe constraints are checked. Caveats ``````` @@ -149,7 +150,7 @@ To disable this feature, one can pass the ``-async-proofs off`` flag to default, pass the ``-async-proofs on`` flag to enable it. Proofs that are known to take little time to process are not delegated -to a worker process. The threshold can be configure with +to a worker process. The threshold can be configured with ``-async-proofs-delegation-threshold``. Default is 0.03 seconds. Batch mode @@ -157,7 +158,7 @@ Batch mode When |Coq| is used as a batch compiler by running `coqc` or `coqtop` -compile, it produces a `.vo` file for each `.v` file. A `.vo` file contains, -among other things, theorems statements and proofs. Hence to produce a +among other things, theorem statements and proofs. Hence to produce a .vo |Coq| need to process all the proofs of the `.v` file. The asynchronous processing of proofs can decouple the generation of a @@ -225,5 +226,5 @@ in all the shells from which |Coq| processes will be started. If one uses just one terminal running the bash shell, then ``export ‘coqworkmgr -j 4‘`` will do the job. -After that, all |Coq| processes, e.g. `coqide` and `coqc`, will honor the +After that, all |Coq| processes, e.g. `coqide` and `coqc`, will respect the limit, globally. diff --git a/doc/sphinx/addendum/program.rst b/doc/sphinx/addendum/program.rst index b685e68e43..d6895f5fe5 100644 --- a/doc/sphinx/addendum/program.rst +++ b/doc/sphinx/addendum/program.rst @@ -18,7 +18,7 @@ program as in a regular functional programming language whilst using as rich a specification as desired and proving that the code meets the specification using the whole |Coq| proof apparatus. This is done using a technique originating from the “Predicate subtyping” mechanism of -PVS :cite:`Rushby98`, which generates type-checking conditions while typing a +PVS :cite:`Rushby98`, which generates type checking conditions while typing a term constrained to a particular type. Here we insert existential variables in the term, which must be filled with proofs to get a complete |Coq| term. |Program| replaces the |Program| tactic by Catherine @@ -38,12 +38,12 @@ obligations which need to be resolved to create the final term. Elaborating programs --------------------- -The main difference from |Coq| is that an object in a type T : Set can -be considered as an object of type { x : T | P} for any wellformed P : -Prop. If we go from T to the subset of T verifying property P, we must -prove that the object under consideration verifies it. Russell will -generate an obligation for every such coercion. In the other -direction, Russell will automatically insert a projection. +The main difference from |Coq| is that an object in a type :g:`T : Set` can +be considered as an object of type :g:`{x : T | P}` for any well-formed +:g:`P : Prop`. If we go from :g:`T` to the subset of :g:`T` verifying property +:g:`P`, we must prove that the object under consideration verifies it. Russell +will generate an obligation for every such coercion. In the other direction, +Russell will automatically insert a projection. Another distinction is the treatment of pattern-matching. Apart from the following differences, it is equivalent to the standard match @@ -67,15 +67,15 @@ operation (see :ref:`extendedpatternmatching`). (match x as y return (x = y -> _) with | 0 => fun H : x = 0 -> t | S n => fun H : x = S n -> u - end) (eq_refl n). + end) (eq_refl x). This permits to get the proper equalities in the context of proof obligations inside clauses, without which reasoning is very limited. -+ Generation of inequalities. If a pattern intersects with a previous - one, an inequality is added in the context of the second branch. See ++ Generation of disequalities. If a pattern intersects with a previous + one, a disequality is added in the context of the second branch. See for example the definition of div2 below, where the second branch is - typed in a context where ∀ p, _ <> S (S p). + typed in a context where :g:`∀ p, _ <> S (S p)`. + Coercion. If the object being matched is coercible to an inductive type, the corresponding coercion will be automatically inserted. This also works with the previous mechanism. @@ -87,8 +87,8 @@ coercions. .. opt:: Program Cases This controls the special treatment of pattern-matching generating equalities - and inequalities when using |Program| (it is on by default). All - pattern-matchings and let-patterns are handled using the standard algorithm + and disequalities when using |Program| (it is on by default). All + pattern-matches and let-patterns are handled using the standard algorithm of |Coq| (see :ref:`extendedpatternmatching`) when this option is deactivated. @@ -104,13 +104,13 @@ Syntactic control over equalities ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To give more control over the generation of equalities, the -typechecker will fall back directly to |Coq|’s usual typing of dependent +type checker will fall back directly to |Coq|’s usual typing of dependent pattern-matching if a return or in clause is specified. Likewise, the if construct is not treated specially by |Program| so boolean tests in the code are not automatically reflected in the obligations. One can -use the dec combinator to get the correct hypotheses as in: +use the :g:`dec` combinator to get the correct hypotheses as in: -.. coqtop:: none +.. coqtop:: in Require Import Program Arith. @@ -120,7 +120,7 @@ use the dec combinator to get the correct hypotheses as in: if dec (leb n 0) then 0 else S (pred n). -The let tupling construct :g:`let (x1, ..., xn) := t in b` does not +The :g:`let` tupling construct :g:`let (x1, ..., xn) := t in b` does not produce an equality, contrary to the let pattern construct :g:`let ’(x1, ..., xn) := t in b`. Also, :g:`term :>` explicitly asks the system to coerce term to its support type. It can be useful in notations, for @@ -175,7 +175,7 @@ Program Definition .. TODO refer to production in alias -See also: Sections :ref:`vernac-controlling-the-reduction-strategies`, :tacn:`unfold` +.. seealso:: Sections :ref:`vernac-controlling-the-reduction-strategies`, :tacn:`unfold` .. _program_fixpoint: @@ -200,7 +200,7 @@ The structural fixpoint operator behaves just like the one of |Coq| (see :cmd:`Fixpoint`), except it may also generate obligations. It works with mutually recursive definitions too. -.. coqtop:: reset none +.. coqtop:: reset in Require Import Program Arith. @@ -264,7 +264,7 @@ Program Lemma Definition` and use it as the goal afterwards. Otherwise the proof will be started with the elaborated version as a goal. The :g:`Program` prefix can similarly be used as a prefix for - :g:`Variable`, :g:`Hypothesis`, :g:`Axiom` etc... + :g:`Variable`, :g:`Hypothesis`, :g:`Axiom` etc. .. _solving_obligations: @@ -300,7 +300,7 @@ optional tactic is replaced by the default one if not specified. Start the proof of the next unsolved obligation. -.. cmd:: Solve Obligations {? of @ident} {? with @tactic} +.. cmd:: Solve Obligations {? {? of @ident} with @tactic} Tries to solve each obligation of ``ident`` using the given ``tactic`` or the default one. @@ -322,13 +322,13 @@ optional tactic is replaced by the default one if not specified. .. opt:: Transparent Obligations - Control whether all obligations should be declared as transparent + Controls whether all obligations should be declared as transparent (the default), or if the system should infer which obligations can be declared opaque. .. opt:: Hide Obligations - Control whether obligations appearing in the + Controls whether obligations appearing in the term should be hidden as implicit arguments of the special constantProgram.Tactics.obligation. diff --git a/doc/sphinx/addendum/ring.rst b/doc/sphinx/addendum/ring.rst index 6a9b343ba8..8cb86e2267 100644 --- a/doc/sphinx/addendum/ring.rst +++ b/doc/sphinx/addendum/ring.rst @@ -13,13 +13,13 @@ The ring and field tactic families :Author: Bruno Barras, Benjamin Grégoire, Assia Mahboubi, Laurent Théry [#f1]_ -This chapter presents the tactics dedicated to deal with ring and +This chapter presents the tactics dedicated to dealing with ring and field equations. What does this tactic do? ------------------------------ -``ring`` does associative-commutative rewriting in ring and semi-ring +``ring`` does associative-commutative rewriting in ring and semiring structures. Assume you have two binary functions :math:`\oplus` and :math:`\otimes` that are associative and commutative, with :math:`\oplus` distributive on :math:`\otimes`, and two constants 0 and 1 that are unities for @@ -36,8 +36,8 @@ is strictly less than the following monomial according to the lexicographic order. It is an easy theorem to show that every polynomial is equivalent (modulo the ring properties) to exactly one canonical sum. This canonical sum is called the normal form of the polynomial. In fact, the actual representation shares -monomials with same prefixes. So what does ring? It normalizes polynomials over -any ring or semi-ring structure. The basic use of ``ring`` is to simplify ring +monomials with same prefixes. So what does the ``ring`` tactic do? It normalizes polynomials over +any ring or semiring structure. The basic use of ``ring`` is to simplify ring expressions, so that the user does not have to deal manually with the theorems of associativity and commutativity. @@ -59,9 +59,8 @@ The variables map It is frequent to have an expression built with :math:`+` and :math:`\times`, but rarely on variables only. Let us associate a number to each subterm of a -ring expression in the Gallina language. For example in the ring |nat|, consider -the expression: - +ring expression in the Gallina language. For example, consider this expression +in the semiring ``nat``: :: @@ -104,7 +103,7 @@ Concrete usage in Coq .. tacn:: ring The ``ring`` tactic solves equations upon polynomial expressions of a ring -(or semi-ring) structure. It proceeds by normalizing both hand sides +(or semiring) structure. It proceeds by normalizing both sides of the equation (w.r.t. associativity, commutativity and distributivity, constant propagation, rewriting of monomials) and comparing syntactically the results. @@ -112,9 +111,9 @@ comparing syntactically the results. .. tacn:: ring_simplify ``ring_simplify`` applies the normalization procedure described above to -the terms given. The tactic then replaces all occurrences of the terms +the given terms. The tactic then replaces all occurrences of the terms given in the conclusion of the goal by their normal forms. If no term -is given, then the conclusion should be an equation and both hand +is given, then the conclusion should be an equation and both sides are normalized. The tactic can also be applied in a hypothesis. The tactic must be loaded by ``Require Import Ring``. The ring structures @@ -187,7 +186,7 @@ Error messages: .. exn:: Cannot find a declared ring structure for equality @term. - Same as above is the case of the ``ring`` tactic. + Same as above in the case of the ``ring`` tactic. Adding a ring structure @@ -198,8 +197,8 @@ carrier set, an equality, and ring operations: ``Ring_theory.ring_theory`` and ``Ring_theory.semi_ring_theory``) satisfies the ring axioms. Semi- rings (rings without + inverse) are also supported. The equality can be either Leibniz equality, or any relation declared as a setoid (see -:ref:`tactics-enabled-on-user-provided-relations`). The definition of ring and semi-rings (see module -``Ring_theory``) is: +:ref:`tactics-enabled-on-user-provided-relations`). +The definitions of ring and semiring (see module ``Ring_theory``) are: .. coqtop:: in @@ -265,13 +264,13 @@ are the implementations of the ring operations, ``==`` is the equality of the coefficients, ``?+!`` is an implementation of this equality, and ``[x]`` is a notation for the image of ``x`` by the ring morphism. -Since |Z| is an initial ring (and |N| is an initial semi-ring), it can +Since |Z| is an initial ring (and |N| is an initial semiring), it can always be considered as a set of coefficients. There are basically three kinds of (semi-)rings: abstract rings to be used when operations are not effective. The set - of coefficients is |Z| (or |N| for semi-rings). + of coefficients is |Z| (or |N| for semirings). computational rings to be used when operations are effective. The @@ -305,7 +304,7 @@ The syntax for adding a new ring is .. cmd:: Add Ring @ident : @term {? ( @ring_mod {* , @ring_mod } )} -The :n:`@ident` is not relevant. It is just used for error messages. The +The :n:`@ident` is not relevant. It is used just for error messages. The :n:`@term` is a proof that the ring signature satisfies the (semi-)ring axioms. The optional list of modifiers is used to tailor the behavior of the tactic. The following list describes their syntax and effects: @@ -386,7 +385,7 @@ sign :n:`@term` div :n:`@term` allows ``ring`` and ``ring_simplify`` to use monomials with - coefficient other than 1 in the rewriting. The term :n:`@term` is a proof + coefficients other than 1 in the rewriting. The term :n:`@term` is a proof that a given division function satisfies the specification of an euclidean division function (:n:`@term` has to be a proof of ``Ring_theory.div_theory``). For example, this function is called when @@ -414,13 +413,13 @@ Error messages: How does it work? ---------------------- -The code of ring is a good example of tactic written using *reflection*. -What is reflection? Basically, it is writing |Coq| tactics in |Coq|, rather -than in |OCaml|. From the philosophical point of view, it is -using the ability of the Calculus of Constructions to speak and reason -about itself. For the ring tactic we used Coq as a programming -language and also as a proof environment to build a tactic and to -prove it correctness. +The code of ``ring`` is a good example of a tactic written using *reflection*. +What is reflection? Basically, using it means that a part of a tactic is written +in Gallina, Coq's language of terms, rather than |Ltac| or |OCaml|. From the +philosophical point of view, reflection is using the ability of the Calculus of +Constructions to speak and reason about itself. For the ``ring`` tactic we used +Coq as a programming language and also as a proof environment to build a tactic +and to prove its correctness. The interested reader is strongly advised to have a look at the file ``Ring_polynom.v``. Here a type for polynomials is defined: @@ -452,7 +451,7 @@ Polynomials in normal form are defined as: where ``Pinj n P`` denotes ``P`` in which :math:`V_i` is replaced by :math:`V_{i+n}` , and ``PX P n Q`` denotes :math:`P \otimes V_1^n \oplus Q'`, `Q'` being `Q` where :math:`V_i` is replaced by :math:`V_{i+1}`. -Variables maps are represented by list of ring elements, and two +Variable maps are represented by lists of ring elements, and two interpretation functions, one that maps a variables map and a polynomial to an element of the concrete ring, and the second one that does the same for normal forms: @@ -490,26 +489,26 @@ concrete expression `p’`, which is the concrete normal form of `p`. This is su `p’` |la| |le| ========= ====== ==== -The user do not see the right part of the diagram. From outside, the -tactic behaves like a |bdi| simplification extended with AC rewriting -rules. Basically, the proof is only the application of the main -correctness theorem to well-chosen arguments. +The user does not see the right part of the diagram. From outside, the +tactic behaves like a |bdi| simplification extended with rewriting rules +for associativity and commutativity. Basically, the proof is only the +application of the main correctness theorem to well-chosen arguments. Dealing with fields ------------------------ .. tacn:: field -The ``field`` tactic is an extension of the ``ring`` to deal with rational -expression. Given a rational expression :math:`F = 0`. It first reduces the +The ``field`` tactic is an extension of the ``ring`` tactic that deals with rational +expressions. Given a rational expression :math:`F = 0`. It first reduces the expression `F` to a common denominator :math:`N/D = 0` where `N` and `D` are two ring expressions. For example, if we take :math:`F = (1 − 1/x) x − x + 1`, this gives :math:`N = (x − 1) x − x^2 + x` and :math:`D = x`. It then calls ring to solve :math:`N = 0`. -Note that ``field`` also generates non-zero conditions for all the +Note that ``field`` also generates nonzero conditions for all the denominators it encounters in the reduction. In our example, it generates the condition :math:`x \neq 0`. These conditions appear as one subgoal -which is a conjunction if there are several denominators. Non-zero +which is a conjunction if there are several denominators. Nonzero conditions are always polynomial expressions. For example when reducing the expression :math:`1/(1 + 1/x)`, two side conditions are generated: :math:`x \neq 0` and :math:`x + 1 \neq 0`. Factorized expressions are broken since @@ -523,7 +522,7 @@ structures can be declared to the system with the ``Add Field`` command (in ``plugins/setoid_ring``). It is exported by module ``Rbase``, so that requiring ``Rbase`` or ``Reals`` is enough to use the field tactics on real numbers. Rational numbers in canonical form are also declared as -a field in module ``Qcanon``. +a field in the module ``Qcanon``. .. example:: @@ -559,8 +558,8 @@ a field in module ``Qcanon``. performs the simplification in the conclusion of the goal, :math:`F_1 = F_2` becomes :math:`N_1 / D_1 = N_2 / D_2`. A normalization step (the same as the one for rings) is then applied to :math:`N_1`, :math:`D_1`, - :math:`N_2` and :math:`D_2`. This way, polynomials remain in factorized form during the - fraction simplifications. This yields smaller expressions when + :math:`N_2` and :math:`D_2`. This way, polynomials remain in factorized form during + fraction simplification. This yields smaller expressions when reducing to the same denominator since common factors can be canceled. .. tacv:: field_simplify [{* @term }] @@ -617,7 +616,7 @@ carrier set, an equality, and field operations: satisfies the field axioms. Semi-fields (fields without + inverse) are also supported. The equality can be either Leibniz equality, or any relation declared as a setoid (see :ref:`tactics-enabled-on-user-provided-relations`). The definition of -fields and semi-fields is: +fields and semifields is: .. coqtop:: in @@ -657,7 +656,7 @@ The syntax for adding a new field is .. cmd:: Add Field @ident : @term {? ( @field_mod {* , @field_mod } )} -The :n:`@ident` is not relevant. It is just used for error +The :n:`@ident` is not relevant. It is used just for error messages. :n:`@term` is a proof that the field signature satisfies the (semi-)field axioms. The optional list of modifiers is used to tailor the behavior of the tactic. @@ -671,7 +670,7 @@ specific modifier: completeness :n:`@term` allows the field tactic to prove automatically - that the image of non-zero coefficients are mapped to non-zero + that the image of nonzero coefficients are mapped to nonzero elements of the field. :n:`@term` is a proof of ``forall x y, [x] == [y] -> x ?=! y = true``, @@ -685,7 +684,7 @@ History of ring First Samuel Boutin designed the tactic ``ACDSimpl``. This tactic did lot of rewriting. But the proofs terms generated by rewriting were too big -for |Coq|’s type-checker. Let us see why: +for |Coq|’s type checker. Let us see why: .. coqtop:: all @@ -704,12 +703,11 @@ it using reflection (see :cite:`Bou97`). Later, it was rewritten by Patrick Loiseleur: the new tactic does not any more require ``ACDSimpl`` to compile and it makes use of |bdi|-reduction not only to replace the rewriting steps, but also to achieve the -interleaving of computation and reasoning (see :ref:`discussion_reflection`). He also wrote a -few |ML| code for the ``Add Ring`` command, that allow to register new rings -dynamically. +interleaving of computation and reasoning (see :ref:`discussion_reflection`). He also wrote +some |ML| code for the ``Add Ring`` command that allows registering new rings dynamically. Proofs terms generated by ring are quite small, they are linear in the -number of :math:`\oplus` and :math:`\otimes` operations in the normalized terms. Type-checking +number of :math:`\oplus` and :math:`\otimes` operations in the normalized terms. Type checking those terms requires some time because it makes a large use of the conversion rule, but memory requirements are much smaller. @@ -733,15 +731,15 @@ Then it is rewritten to ``34 − x + 2 * x + 12``, very far from the expected re Here rewriting is not sufficient: you have to do some kind of reduction (some kind of computation) to achieve the normalization. -The tactic ``ring`` is not only faster than a classical one: using -reflection, we get for free integration of computation and reasoning -that would be very complex to implement in the classic fashion. +The tactic ``ring`` is not only faster than the old one: by using +reflection, we get for free the integration of computation and reasoning +that would be very difficult to implement without it. Is it the ultimate way to write tactics? The answer is: yes and no. -The ``ring`` tactic uses intensively the conversion rule of |Cic|, that is -replaces proof by computation the most as it is possible. It can be -useful in all situations where a classical tactic generates huge proof -terms. Symbolic Processing and Tautologies are in that case. But there +The ``ring`` tactic intensively uses the conversion rules of the Calculus of +Inductive Constructions, i.e. it replaces proofs by computations as much as possible. +It can be useful in all situations where a classical tactic generates huge proof +terms, like symbolic processing and tautologies. But there are also tactics like ``auto`` or ``linear`` that do many complex computations, using side-effects and backtracking, and generate a small proof term. Clearly, it would be significantly less efficient to replace them by @@ -750,12 +748,12 @@ tactics using reflection. Another idea suggested by Benjamin Werner: reflection could be used to couple an external tool (a rewriting program or a model checker) with |Coq|. We define (in |Coq|) a type of terms, a type of *traces*, and -prove a correction theorem that states that *replaying traces* is safe -w.r.t some interpretation. Then we let the external tool do every +prove a correctness theorem that states that *replaying traces* is safe +with respect to some interpretation. Then we let the external tool do every computation (using side-effects, backtracking, exception, or others features that are not available in pure lambda calculus) to produce -the trace: now we can check in |Coq| that the trace has the expected -semantic by applying the correction lemma. +the trace. Now we can check in |Coq| that the trace has the expected +semantics by applying the correctness theorem. diff --git a/doc/sphinx/addendum/type-classes.rst b/doc/sphinx/addendum/type-classes.rst index 68b5b9d6fe..ab4b4a9824 100644 --- a/doc/sphinx/addendum/type-classes.rst +++ b/doc/sphinx/addendum/type-classes.rst @@ -6,7 +6,7 @@ Type Classes ============ This chapter presents a quick reference of the commands related to type -classes. For an actual introduction to type classes, there is a +classes. For an actual introduction to typeclasses, there is a description of the system :cite:`sozeau08` and the literature on type classes in Haskell which also applies. @@ -76,7 +76,7 @@ for dealing with obligations. Binding classes --------------- -Once a type class is declared, one can use it in class binders: +Once a typeclass is declared, one can use it in class binders: .. coqtop:: all @@ -92,7 +92,7 @@ found, an error is raised: Fail Definition neqb' (A : Type) (x y : A) := negb (eqb x y). -The algorithm used to solve constraints is a variant of the eauto +The algorithm used to solve constraints is a variant of the :tacn:`eauto` tactic that does proof search with a set of lemmas (the instances). It will use local hypotheses as well as declared lemmas in the ``typeclass_instances`` database. Hence the example can also be @@ -103,13 +103,13 @@ written: Definition neqb' A (eqa : EqDec A) (x y : A) := negb (eqb x y). However, the generalizing binders should be used instead as they have -particular support for type classes: +particular support for typeclasses: -+ They automatically set the maximally implicit status for type class ++ They automatically set the maximally implicit status for typeclass arguments, making derived functions as easy to use as class methods. In the example above, ``A`` and ``eqa`` should be set maximally implicit. + They support implicit quantification on partially applied type - classes (:ref:`implicit-generalization`). Any argument not given as part of a type class + classes (:ref:`implicit-generalization`). Any argument not given as part of a typeclass binder will be automatically generalized. + They also support implicit quantification on :ref:`superclasses`. @@ -120,7 +120,7 @@ Following the previous example, one can write: Generalizable Variables A B C. - Definition neqb_impl `{eqa : EqDec A} (x y : A) := negb (eqb x y). + Definition neqb_implicit `{eqa : EqDec A} (x y : A) := negb (eqb x y). Here ``A`` is implicitly generalized, and the resulting function is equivalent to the one above. @@ -148,7 +148,7 @@ database. Sections and contexts --------------------- -To ease the parametrization of developments by type classes, we provide a new +To ease the parametrization of developments by typeclasses, we provide a new way to introduce variables into section contexts, compatible with the implicit argument mechanism. The new command works similarly to the :cmd:`Variables` vernacular, except it accepts any binding context as argument. For example: @@ -193,7 +193,7 @@ superclasses as a binding context: Class Ord `(E : EqDec A) := { le : A -> A -> bool }. Contrary to Haskell, we have no special syntax for superclasses, but -this declaration is morally equivalent to: +this declaration is equivalent to: :: @@ -248,7 +248,7 @@ properties, e.g.: This declares singleton classes for reflexive and transitive relations, (see the :ref:`singleton class <singleton-class>` variant for an -explanation). These may be used as part of other classes: +explanation). These may be used as parts of other classes: .. coqtop:: all @@ -271,7 +271,7 @@ Summary of the commands .. cmd:: Class @ident {? @binders} : {? @sort} := {? @ident} { {+; @ident :{? >} @term } } - The :cmd:`Class` command is used to declare a type class with parameters + The :cmd:`Class` command is used to declare a typeclass with parameters ``binders`` and fields the declared record fields. Variants: @@ -302,7 +302,7 @@ Variants: .. cmd:: Instance @ident {? @binders} : Class t1 … tn [| priority] := { field1 := b1 ; …; fieldi := bi } -The :cmd:`Instance` command is used to declare a type class instance named +The :cmd:`Instance` command is used to declare a typeclass instance named ``ident`` of the class :cmd:`Class` with parameters ``t1`` to ``tn`` and fields ``b1`` to ``bi``, where each field must be a declared field of the class. Missing fields must be filled in interactive proof mode. @@ -310,7 +310,7 @@ the class. Missing fields must be filled in interactive proof mode. An arbitrary context of ``binders`` can be put after the name of the instance and before the colon to declare a parameterized instance. An optional priority can be declared, 0 being the highest priority as for -auto hints. If the priority is not specified, it defaults to the number +:tacn:`auto` hints. If the priority is not specified, it defaults to the number of non-dependent binders of the instance. .. cmdv:: Instance @ident {? @binders} : forall {? @binders}, Class t1 … tn [| priority] := @term @@ -329,7 +329,7 @@ of non-dependent binders of the instance. .. cmdv:: Program Instance :name: Program Instance - Switches the type-checking to Program (chapter :ref:`programs`) and + Switches the type checking to Program (chapter :ref:`programs`) and uses the obligation mechanism to manage missing fields. .. cmdv:: Declare Instance @@ -342,12 +342,12 @@ of non-dependent binders of the instance. Besides the :cmd:`Class` and :cmd:`Instance` vernacular commands, there are a -few other commands related to type classes. +few other commands related to typeclasses. .. cmd:: Existing Instance {+ @ident} [| priority] - This commands adds an arbitrary list of constants whose type ends with - an applied type class to the instance database with an optional + This command adds an arbitrary list of constants whose type ends with + an applied typeclass to the instance database with an optional priority. It can be used for redeclaring instances at the end of sections, or declaring structure projections as instances. This is equivalent to ``Hint Resolve ident : typeclass_instances``, except it @@ -367,11 +367,11 @@ few other commands related to type classes. + Contrary to :tacn:`eauto` and :tacn:`auto`, the resolution is done entirely in the new proof engine (as of Coq 8.6), meaning that backtracking is available among dependent subgoals, and shelving goals is supported. - typeclasses eauto is a multi-goal tactic. It analyses the dependencies + ``typeclasses eauto`` is a multi-goal tactic. It analyses the dependencies between subgoals to avoid backtracking on subgoals that are entirely independent. - + When called with no arguments, typeclasses eauto uses + + When called with no arguments, ``typeclasses eauto`` uses the ``typeclass_instances`` database by default (instead of core). Dependent subgoals are automatically shelved, and shelved goals can remain after resolution ends (following the behavior of Coq 8.5). @@ -379,22 +379,22 @@ few other commands related to type classes. .. note:: As of Coq 8.6, ``all:once (typeclasses eauto)`` faithfully mimicks what happens during typeclass resolution when it is called - during refinement/type-inference, except that *only* declared class + during refinement/type inference, except that *only* declared class subgoals are considered at the start of resolution during type inference, while ``all`` can select non-class subgoals as well. It might move to ``all:typeclasses eauto`` in future versions when the refinement engine will be able to backtrack. - + When called with specific databases (e.g. with), typeclasses eauto + + When called with specific databases (e.g. with), ``typeclasses eauto`` allows shelved goals to remain at any point during search and treat - typeclasses goals like any other. + typeclass goals like any other. + The transparency information of databases is used consistently for all hints declared in them. It is always used when calling the - unifier. When considering the local hypotheses, we use the transparent + unifier. When considering local hypotheses, we use the transparent state of the first hint database given. Using an empty database (created with :cmd:`Create HintDb` for example) with unfoldable variables and - constants as the first argument of typeclasses eauto hence makes + constants as the first argument of ``typeclasses eauto`` hence makes resolution with the local hypotheses use full conversion during unification. @@ -403,10 +403,10 @@ few other commands related to type classes. .. warning:: The semantics for the limit :n:`@num` - is different than for auto. By default, if no limit is given the - search is unbounded. Contrary to auto, introduction steps (intro) are + is different than for auto. By default, if no limit is given, the + search is unbounded. Contrary to :tacn:`auto`, introduction steps are counted, which might result in larger limits being necessary when - searching with typeclasses eauto than auto. + searching with ``typeclasses eauto`` than with :tacn:`auto`. .. cmdv:: typeclasses eauto with {+ @ident} @@ -417,11 +417,11 @@ few other commands related to type classes. .. tacn:: autoapply @term with @ident :name: autoapply - The tactic autoapply applies a term using the transparency information + The tactic ``autoapply`` applies a term using the transparency information of the hint database ident, and does *no* typeclass resolution. This can be used in :cmd:`Hint Extern`’s for typeclass instances (in the hint database ``typeclass_instances``) to allow backtracking on the typeclass - subgoals created by the lemma application, rather than doing type class + subgoals created by the lemma application, rather than doing typeclass resolution locally at the hint application time. .. _TypeclassesTransparent: @@ -431,7 +431,7 @@ Typeclasses Transparent, Typclasses Opaque .. cmd:: Typeclasses Transparent {+ @ident} - This command defines makes the identifiers transparent during type class + This command makes the identifiers transparent during typeclass resolution. .. cmd:: Typeclasses Opaque {+ @ident} @@ -461,8 +461,8 @@ Options .. opt:: Typeclasses Dependency Order This option (on by default since 8.6) respects the dependency order - between subgoals, meaning that subgoals which are depended on by other - subgoals come first, while the non-dependent subgoals were put before + between subgoals, meaning that subgoals on which other subgoals depend + come first, while the non-dependent subgoals were put before the dependent ones previously (Coq 8.5 and below). This can result in quite different performance behaviors of proof search. @@ -487,16 +487,18 @@ Options avoiding (functional) eta-expansions in the generated proof term. It does so by allowing hints that conclude in a product to apply to a goal with a matching product directly, avoiding an introduction. - *Warning:* this can be expensive as it requires rebuilding hint - clauses dynamically, and does not benefit from the invertibility - status of the product introduction rule, resulting in potentially more - expensive proof-search (i.e. more useless backtracking). + .. warning:: + + This can be expensive as it requires rebuilding hint + clauses dynamically, and does not benefit from the invertibility + status of the product introduction rule, resulting in potentially more + expensive proof-search (i.e. more useless backtracking). .. opt:: Typeclass Resolution For Conversion This option (on by default) controls the use of typeclass resolution - when a unification problem cannot be solved during elaboration/type- + when a unification problem cannot be solved during elaboration/type inference. With this option on, when a unification fails, typeclass resolution is tried before launching unification once again. @@ -548,7 +550,7 @@ Typeclasses eauto `:=` .. cmd:: Typeclasses eauto := {? debug} {? {dfs | bfs}} depth - This command allows more global customization of the type class + This command allows more global customization of the typeclass resolution tactic. The semantics of the options are: + ``debug`` In debug mode, the trace of successfully applied tactics is diff --git a/doc/sphinx/addendum/universe-polymorphism.rst b/doc/sphinx/addendum/universe-polymorphism.rst index 6e7ccba63c..7e77dea457 100644 --- a/doc/sphinx/addendum/universe-polymorphism.rst +++ b/doc/sphinx/addendum/universe-polymorphism.rst @@ -36,7 +36,7 @@ error: Fail Definition selfid := identity (@identity). Indeed, the global level ``Top.1`` would have to be strictly smaller than -itself for this self-application to typecheck, as the type of +itself for this self-application to type check, as the type of :g:`(@identity)` is :g:`forall (A : Type@{Top.1}), A -> A` whose type is itself :g:`Type@{Top.1+1}`. @@ -72,7 +72,7 @@ different. This can be seen when the :opt:`Printing Universes` option is on: Now :g:`pidentity` is used at two different levels: at the head of the application it is instantiated at ``Top.3`` while in the argument position it is instantiated at ``Top.4``. This definition is only valid as long as -``Top.4`` is strictly smaller than ``Top.3``, as show by the constraints. Note +``Top.4`` is strictly smaller than ``Top.3``, as shown by the constraints. Note that this definition is monomorphic (not universe polymorphic), so the two universes (in this case ``Top.3`` and ``Top.4``) are actually global levels. diff --git a/doc/sphinx/biblio.bib b/doc/sphinx/biblio.bib index 3574bf6750..c74d8f540c 100644 --- a/doc/sphinx/biblio.bib +++ b/doc/sphinx/biblio.bib @@ -1,7 +1,7 @@ @String{jfp = "Journal of Functional Programming"} @String{lncs = "Lecture Notes in Computer Science"} @String{lnai = "Lecture Notes in Artificial Intelligence"} -@String{SV = "{Sprin-ger-Verlag}"} +@String{SV = "{Springer-Verlag}"} @InCollection{Asp00, Title = {Proof General: A Generic Tool for Proof Development}, @@ -252,13 +252,13 @@ s}, booktitle = {TYPES}, year = 2002, crossref = {DBLP:conf/types/2002}, - url = {draft at \url{http://www.irif.fr/~letouzey/download/extraction2002.pdf}} + url = {http://www.irif.fr/~letouzey/download/extraction2002.pdf} } @InProceedings{Luttik97specificationof, author = {Sebastiaan P. Luttik and Eelco Visser}, booktitle = {2nd International Workshop on the Theory and Practice of Algebraic Specifications (ASF+SDF'97), Electronic Workshops in Computing}, - publisher = {Springer-Verlag}, + publisher = SV, title = {Specification of Rewriting Strategies}, year = {1997} } diff --git a/doc/sphinx/credits.rst b/doc/sphinx/credits.rst index 2988b194e2..be0b5d5f12 100644 --- a/doc/sphinx/credits.rst +++ b/doc/sphinx/credits.rst @@ -60,7 +60,7 @@ the language ML. Automated theorem-proving was pioneered in the 1960’s by Davis and Putnam in propositional calculus. A complete mechanization (in the sense -of a semi-decision procedure) of classical first-order logic was +of a semidecision procedure) of classical first-order logic was proposed in 1965 by J.A. Robinson, with a single uniform inference rule called *resolution*. Resolution relies on solving equations in free algebras (i.e. term structures), using the *unification algorithm*. Many @@ -320,7 +320,7 @@ in March 2001, version 7.1 in September 2001, version 7.2 in January Jean-Christophe Filliâtre designed the architecture of the new system. He introduced a new representation for environments and wrote a new -kernel for type-checking terms. His approach was to use functional +kernel for type checking terms. His approach was to use functional data-structures in order to get more sharing, to prepare the addition of modules and also to get closer to a certified kernel. @@ -352,7 +352,7 @@ sensible. Jean-Christophe Filliâtre wrote ``coqdoc``, a documentation tool for |Coq| libraries usable from version 7.2. Bruno Barras improved the efficiency of the reduction algorithm and the -confidence level in the correctness of |Coq| critical type-checking +confidence level in the correctness of |Coq| critical type checking algorithm. Yves Bertot designed the ``SearchPattern`` and ``SearchRewrite`` tools @@ -506,7 +506,7 @@ Credits: version 8.1 Coq version 8.1 adds various new functionalities. Benjamin Grégoire implemented an alternative algorithm to check the -convertibility of terms in the |Coq| type-checker. This alternative +convertibility of terms in the |Coq| type checker. This alternative algorithm works by compilation to an efficient bytecode that is interpreted in an abstract machine similar to Xavier Leroy’s ZINC machine. Convertibility is performed by comparing the normal forms. This @@ -526,7 +526,7 @@ Claudio Sacerdoti Coen added new features to the module system. Benjamin Grégoire, Assia Mahboubi and Bruno Barras developed a new, more efficient and more general simplification algorithm for rings and -semi-rings. +semirings. Laurent Théry and Bruno Barras developed a new, significantly more efficient simplification algorithm for fields. @@ -586,11 +586,11 @@ Coq version 8.2 adds new features, new libraries and improves on many various aspects. Regarding the language of |Coq|, the main novelty is the introduction by -Matthieu Sozeau of a package of commands providing Haskell-style type -classes. Type classes, that come with a few convenient features such as +Matthieu Sozeau of a package of commands providing Haskell-style typeclasses. +Typeclasses, which come with a few convenient features such as type-based resolution of implicit arguments, play a new landmark role in the architecture of |Coq| with respect to automation. For -instance, thanks to type classes support, Matthieu Sozeau could +instance, thanks to typeclass support, Matthieu Sozeau could implement a new resolution-based version of the tactics dedicated to rewriting on arbitrary transitive relations. @@ -648,7 +648,7 @@ maintenance and coqdoc support, Vincent Siles contributed extensions of the Scheme command and of injection. Bruno Barras implemented the `coqchk` tool: this is a stand-alone -type-checker that can be used to certify .vo files. Especially, as this +type checker that can be used to certify .vo files. Especially, as this verifier runs in a separate process, it is granted not to be “hijacked” by virtually malicious extensions added to |Coq|. @@ -712,7 +712,7 @@ The new tactic nsatz is due to Loïc Pottier. It works by computing Gröbner bases. Regarding the existing tactics, various improvements have been done by Matthieu Sozeau, Hugo Herbelin and Pierre Letouzey. -Matthieu Sozeau extended and refined the type classes and Program +Matthieu Sozeau extended and refined the typeclasses and Program features (the Russell language). Pierre Letouzey maintained and improved the extraction mechanism. Bruno Barras and Élie Soubiran maintained the Coq checker, Julien Forest maintained the Function mechanism for @@ -810,7 +810,7 @@ Regarding the high-level specification language, Pierre Boutillier introduced the ability to give implicit arguments to anonymous functions, Hugo Herbelin introduced the ability to define notations with several binders (e.g. ``exists x y z, P``), Matthieu Sozeau made the -type classes inference mechanism more robust and predictable, Enrico +typeclass inference mechanism more robust and predictable, Enrico Tassi introduced a command Arguments that generalizes Implicit Arguments and Arguments Scope for assigning various properties to arguments of constants. Various improvements in the type inference algorithm were @@ -831,7 +831,7 @@ vm\_compute. Bug fixes and miscellaneous improvements of the tactic language came from Hugo Herbelin, Pierre Letouzey and Matthieu Sozeau. Regarding decision tactics, Loïc Pottier maintained nsatz, moving in -particular to a type-class based reification of goals while Frédéric +particular to a typeclass based reification of goals while Frédéric Besson maintained Micromega, adding in particular support for division. Regarding vernacular commands, Stéphane Glondu provided new commands to @@ -1074,7 +1074,7 @@ over 100 contributions integrated. The main user visible changes are: document. - More access to the proof engine features from Ltac: goal management - primitives, range selectors and a typeclasses eauto engine handling + primitives, range selectors and a ``typeclasses eauto`` engine handling multiple goals and multiple successes, by Cyprien Mangin, Matthieu Sozeau and Arnaud Spiwack. @@ -1234,7 +1234,7 @@ The efficiency of the whole system has been significantly improved thanks to contributions from Pierre-Marie Pédrot, Maxime Dénès and Matthieu Sozeau and performance issue tracking by Jason Gross and Paul Steckler. -Thomas Sibut-Pinote and Hugo Herbelin added support for side effects hooks in +Thomas Sibut-Pinote and Hugo Herbelin added support for side effect hooks in cbv, cbn and simpl. The side effects are provided via a plugin available at https://github.com/herbelin/reduction-effects/. @@ -1292,7 +1292,7 @@ integration of new features, with an important focus given to compatibility and performance issues, resulting in a hopefully more robust release than |Coq| 8.6 while maintaining compatibility. -|Coq| Enhancement Proposals (CEPs for short) and open pull-requests discussions +|Coq| Enhancement Proposals (CEPs for short) and open pull request discussions were used to discuss publicly the new features. The |Coq| consortium, an organization directed towards users and supporters of the diff --git a/doc/sphinx/introduction.rst b/doc/sphinx/introduction.rst index 1a610396e5..b57e4b209c 100644 --- a/doc/sphinx/introduction.rst +++ b/doc/sphinx/introduction.rst @@ -7,8 +7,8 @@ Introduction This document is the Reference Manual of the |Coq| proof assistant. To start using Coq, it is advised to first read a tutorial. Links to several tutorials can be found at -https://coq.inria.fr/documentation (see also -https://github.com/coq/coq/wiki#coq-tutorials). +https://coq.inria.fr/documentation and +https://github.com/coq/coq/wiki#coq-tutorials The |Coq| system is designed to develop mathematical proofs, and especially to write formal specifications, programs and to verify that @@ -20,7 +20,7 @@ properties and proofs are formalized in the same language called *Calculus of Inductive Constructions*, that is a :math:`\lambda`-calculus with a rich type system. All logical judgments in |Coq| are typing judgments. The very heart of the |Coq| system is the -type-checking algorithm that checks the correctness of proofs, in other +type checking algorithm that checks the correctness of proofs, in other words that checks that a program complies to its specification. |Coq| also provides an interactive proof assistant to build proofs using specific programs called *tactics*. diff --git a/doc/sphinx/language/cic.rst b/doc/sphinx/language/cic.rst index 98e81ebc65..3d3a1b11b1 100644 --- a/doc/sphinx/language/cic.rst +++ b/doc/sphinx/language/cic.rst @@ -96,8 +96,9 @@ constraints between the universe variables is maintained globally. To ensure the existence of a mapping of the universes to the positive integers, the graph of constraints must remain acyclic. Typing expressions that violate the acyclicity of the graph of constraints -results in a Universe inconsistency error (see also Section -:ref:`printing-universes`). +results in a Universe inconsistency error. + +.. seealso:: Section :ref:`printing-universes`. .. _Terms: @@ -723,6 +724,7 @@ each :math:`T` in :math:`(t:T)∈Γ_I` can be written as: :math:`∀Γ_P,∀Γ_{ the sort of the inductive type t (not to be confused with :math:`\Sort` which is the set of sorts). .. example:: + The declaration for parameterized lists is: .. math:: @@ -741,11 +743,12 @@ the sort of the inductive type t (not to be confused with :math:`\Sort` which is | cons : A -> list A -> list A. .. example:: + The declaration for a mutual inductive definition of tree and forest is: .. math:: - \ind{~}{\left[\begin{array}{rcl}\tree&:&\Set\\\forest&:&\Set\end{array}\right]} + \ind{0}{\left[\begin{array}{rcl}\tree&:&\Set\\\forest&:&\Set\end{array}\right]} {\left[\begin{array}{rcl} \node &:& \forest → \tree\\ \emptyf &:& \forest\\ @@ -763,10 +766,11 @@ the sort of the inductive type t (not to be confused with :math:`\Sort` which is | consf : tree -> forest -> forest. .. example:: + The declaration for a mutual inductive definition of even and odd is: .. math:: - \ind{1}{\left[\begin{array}{rcl}\even&:&\nat → \Prop \\ + \ind{0}{\left[\begin{array}{rcl}\even&:&\nat → \Prop \\ \odd&:&\nat → \Prop \end{array}\right]} {\left[\begin{array}{rcl} \evenO &:& \even~0\\ @@ -778,7 +782,7 @@ the sort of the inductive type t (not to be confused with :math:`\Sort` which is .. coqtop:: in - Inductive even : nat -> prop := + Inductive even : nat -> Prop := | even_O : even 0 | even_S : forall n, odd n -> even (S n) with odd : nat -> prop := @@ -811,6 +815,7 @@ contains an inductive declaration. E[Γ] ⊢ c : C .. example:: + Provided that our environment :math:`E` contains inductive definitions we showed before, these two inference rules above enable us to conclude that: @@ -919,6 +924,7 @@ condition* for a constant :math:`X` in the following cases: .. example:: + For instance, if one considers the following variant of a tree type branching over the natural numbers: @@ -961,7 +967,7 @@ such that :math:`Γ_I` is :math:`[I_1 :∀ Γ_P ,A_1 ;…;I_k :∀ Γ_P ,A_k]`, .. inference:: W-Ind \WFE{Γ_P} - (E[Γ_P ] ⊢ A_j : s_j' )_{j=1… k} + (E[Γ_P ] ⊢ A_j : s_j )_{j=1… k} (E[Γ_I ;Γ_P ] ⊢ C_i : s_{q_i} )_{i=1… n} ------------------------------------------ \WF{E;\ind{p}{Γ_I}{Γ_C}}{Γ} @@ -985,6 +991,7 @@ the Type hierarchy. .. example:: + It is well known that the existential quantifier can be encoded as an inductive definition. The following declaration introduces the second- order existential quantifier :math:`∃ X.P(X)`. @@ -1019,7 +1026,7 @@ Template polymorphism +++++++++++++++++++++ Inductive types declared in :math:`\Type` are polymorphic over their arguments -in :math:`\Type`. If :math:`A` is an arity of some sort and math:`s` is a sort, we write :math:`A_{/s}` +in :math:`\Type`. If :math:`A` is an arity of some sort and :math:`s` is a sort, we write :math:`A_{/s}` for the arity obtained from :math:`A` by replacing its sort with :math:`s`. Especially, if :math:`A` is well-typed in some global environment and local context, then :math:`A_{/s}` is typable by typability of all products in the @@ -1102,6 +1109,7 @@ sorts at each instance of a pattern-matching (see Section :ref:`Destructors`). A an example, let us consider the following definition: .. example:: + .. coqtop:: in Inductive option (A:Type) : Type := @@ -1118,6 +1126,7 @@ if :g:`option` is applied to a type in :math:`\Prop`, then, the result is not se if set in :math:`\Prop`. .. example:: + .. coqtop:: all Check (fun A:Set => option A). @@ -1126,6 +1135,7 @@ if set in :math:`\Prop`. Here is another example. .. example:: + .. coqtop:: in Inductive prod (A B:Type) : Type := pair : A -> B -> prod A B. @@ -1136,6 +1146,7 @@ none in :math:`\Type`, and in :math:`\Type` otherwise. In all cases, the three k eliminations schemes are allowed. .. example:: + .. coqtop:: all Check (fun A:Set => prod A). @@ -1242,7 +1253,7 @@ In this expression, if :math:`m` eventually happens to evaluate to and it will reduce to :math:`f_i` where the :math:`x_{i1} …x_{ip_i}` are replaced by the :math:`u_1 … u_{p_i}` according to the ι-reduction. -Actually, for type-checking a :math:`\Match…\with…\endkw` expression we also need +Actually, for type checking a :math:`\Match…\with…\endkw` expression we also need to know the predicate P to be proved by case analysis. In the general case where :math:`I` is an inductively defined :math:`n`-ary relation, :math:`P` is a predicate over :math:`n+1` arguments: the :math:`n` first ones correspond to the arguments of :math:`I` @@ -1324,6 +1335,7 @@ the extraction mechanism. Assume :math:`A` and :math:`B` are two propositions, a logical disjunction :math:`A ∨ B` is defined inductively by: .. example:: + .. coqtop:: in Inductive or (A B:Prop) : Prop := @@ -1334,6 +1346,7 @@ The following definition which computes a boolean value by case over the proof of :g:`or A B` is not accepted: .. example:: + .. coqtop:: all Fail Definition choice (A B: Prop) (x:or A B) := @@ -1357,6 +1370,7 @@ property which are provably different, contradicting the proof- irrelevance property which is sometimes a useful axiom: .. example:: + .. coqtop:: all Axiom proof_irrelevance : forall (P : Prop) (x y : P), x=y. @@ -1385,11 +1399,12 @@ arguments of this constructor have type :math:`\Prop`. In that case, there is a canonical way to interpret the informative extraction on an object in that type, such that the elimination on any sort :math:`s` is legal. Typical examples are the conjunction of non-informative propositions and the -equality. If there is an hypothesis :math:`h:a=b` in the local context, it can +equality. If there is a hypothesis :math:`h:a=b` in the local context, it can be used for rewriting not only in logical propositions but also in any type. .. example:: + .. coqtop:: all Print eq_rec. @@ -1421,6 +1436,7 @@ We write :math:`\{c\}^P` for :math:`\{c:C\}^P` with :math:`C` the type of :math: .. example:: + The following term in concrete syntax:: match t as l return P' with @@ -1485,6 +1501,7 @@ definition :math:`\ind{r}{Γ_I}{Γ_C}` with :math:`Γ_C = [c_1 :C_1 ;…;c_n :C_ .. example:: + Below is a typing rule for the term shown in the previous example: .. inference:: list example @@ -1634,6 +1651,7 @@ The following definitions are correct, we enter them using the :cmd:`Fixpoint` command and show the internal representation. .. example:: + .. coqtop:: all Fixpoint plus (n m:nat) {struct n} : nat := @@ -1804,17 +1822,18 @@ definitions can be found in :cite:`Gimenez95b,Gim98,GimCas05`. The Calculus of Inductive Constructions with impredicative Set ----------------------------------------------------------------- -|Coq| can be used as a type-checker for the Calculus of Inductive +|Coq| can be used as a type checker for the Calculus of Inductive Constructions with an impredicative sort :math:`\Set` by using the compiler option ``-impredicative-set``. For example, using the ordinary `coqtop` command, the following is rejected, .. example:: + .. coqtop:: all Fail Definition id: Set := forall X:Set,X->X. -while it will type-check, if one uses instead the `coqtop` +while it will type check, if one uses instead the `coqtop` ``-impredicative-set`` option.. The major change in the theory concerns the rule for product formation diff --git a/doc/sphinx/language/coq-library.rst b/doc/sphinx/language/coq-library.rst index 52c56d2bd2..9de30e2190 100644 --- a/doc/sphinx/language/coq-library.rst +++ b/doc/sphinx/language/coq-library.rst @@ -848,6 +848,7 @@ Notation Interpretation Precedence Associativity .. example:: + .. coqtop:: all reset Require Import ZArith. @@ -887,6 +888,7 @@ Notation Interpretation =============== =================== .. example:: + .. coqtop:: all reset Require Import Reals. @@ -906,6 +908,7 @@ tactics (see Chapter :ref:`tactics`), there are also: Proves that two real integer constants are different. .. example:: + .. coqtop:: all reset Require Import DiscrR. @@ -919,6 +922,7 @@ tactics (see Chapter :ref:`tactics`), there are also: Allows unfolding the ``Rabs`` constant and splits corresponding conjunctions. .. example:: + .. coqtop:: all reset Require Import Reals. @@ -933,6 +937,7 @@ tactics (see Chapter :ref:`tactics`), there are also: corresponding to the condition on each operand of the product. .. example:: + .. coqtop:: all reset Require Import Reals. diff --git a/doc/sphinx/language/gallina-extensions.rst b/doc/sphinx/language/gallina-extensions.rst index 394b928ada..0fbe7ac70b 100644 --- a/doc/sphinx/language/gallina-extensions.rst +++ b/doc/sphinx/language/gallina-extensions.rst @@ -70,7 +70,9 @@ generates a variant type definition with just one constructor: To build an object of type :n:`@ident`, one should provide the constructor :n:`@ident₀` with the appropriate number of terms filling the fields of the record. -.. example:: Let us define the rational :math:`1/2`: +.. example:: + + Let us define the rational :math:`1/2`: .. coqtop:: in @@ -210,7 +212,7 @@ During the definition of the one-constructor inductive definition, all the errors of inductive definitions, as described in Section :ref:`gallina-inductive-definitions`, may also occur. -**See also** Coercions and records in Section :ref:`coercions-classes-as-records` of the chapter devoted to coercions. +.. seealso:: Coercions and records in section :ref:`coercions-classes-as-records` of the chapter devoted to coercions. .. _primitive_projections: @@ -227,7 +229,7 @@ term constructor `r.(p)` representing a primitive projection `p` applied to a record object `r` (i.e., primitive projections are always applied). Even if the record type has parameters, these do not appear at applications of the projection, considerably reducing the sizes of -terms when manipulating parameterized records and typechecking time. +terms when manipulating parameterized records and type checking time. On the user level, primitive projections can be used as a replacement for the usual defined ones, although there are a few notable differences. @@ -326,7 +328,7 @@ into a sequence of match on simple patterns. Especially, a construction defined using the extended match is generally printed under its expanded form (see :opt:`Printing Matching`). -See also: :ref:`extendedpatternmatching`. +.. seealso:: :ref:`extendedpatternmatching`. .. _if-then-else: @@ -709,7 +711,7 @@ terminating functions. `functional inversion` will not be available for the function. -See also: :ref:`functional-scheme` and :tacn:`function induction` +.. seealso:: :ref:`functional-scheme` and :tacn:`function induction` Depending on the ``{…}`` annotation, different definition mechanisms are used by ``Function``. A more precise description is given below. @@ -1258,7 +1260,7 @@ identifiers qualid, i.e. as list of identifiers separated by dots (see |Coq| library ``Arith`` is named ``Coq.Arith.Mult``. The identifier that starts the name of a library is called a *library root*. All library files of the standard library of |Coq| have the reserved root |Coq| but library -file names based on other roots can be obtained by using |Coq| commands +filenames based on other roots can be obtained by using |Coq| commands (coqc, coqtop, coqdep, …) options ``-Q`` or ``-R`` (see :ref:`command-line-options`). Also, when an interactive |Coq| session starts, a library of root ``Top`` is started, unless option ``-top`` or ``-notop`` is set (see :ref:`command-line-options`). @@ -1292,7 +1294,7 @@ short name (or even same partially qualified names as soon as the full names are different). Notice that the notion of absolute, partially qualified and short -names also applies to library file names. +names also applies to library filenames. **Visibility** @@ -1326,7 +1328,7 @@ accessible, absolute names can never be hidden. Locate nat. -See also: Commands :cmd:`Locate` and :cmd:`Locate Library`. +.. seealso:: Commands :cmd:`Locate` and :cmd:`Locate Library`. .. _libraries-and-filesystem: @@ -1512,7 +1514,8 @@ says that the implicit argument is maximally inserted. Each implicit argument can be declared to have to be inserted maximally or non maximally. This can be governed argument per argument by the command :cmd:`Arguments (implicits)` or globally by the :opt:`Maximal Implicit Insertion` option. -See also :ref:`displaying-implicit-args`. + +.. seealso:: :ref:`displaying-implicit-args`. Casual use of implicit arguments @@ -1849,15 +1852,15 @@ are named as expected. .. example:: (continued) -.. coqtop:: all + .. coqtop:: all - Arguments p [s t] _ [u] _: rename. + Arguments p [s t] _ [u] _: rename. - Check (p r1 (u:=c)). + Check (p r1 (u:=c)). - Check (p (s:=a) (t:=b) r1 (u:=c) r2). + Check (p (s:=a) (t:=b) r1 (u:=c) r2). - Fail Arguments p [s t] _ [w] _ : assert. + Fail Arguments p [s t] _ [w] _ : assert. .. _displaying-implicit-args: @@ -1885,7 +1888,7 @@ arguments that are not detected as strict implicit arguments. This “defensive” mode can quickly make the display cumbersome so this can be deactivated by turning this option off. -See also: :opt:`Printing All`. +.. seealso:: :opt:`Printing All`. Interaction with subtyping ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1935,7 +1938,7 @@ in :ref:`canonicalstructures`; here only a simple example is given. Assume that :token:`qualid` denotes an object ``(Build_struct`` |c_1| … |c_n| ``)`` in the structure :g:`struct` of which the fields are |x_1|, …, |x_n|. Then, each time an equation of the form ``(``\ |x_i| ``_)`` |eq_beta_delta_iota_zeta| |c_i| has to be - solved during the type-checking process, :token:`qualid` is used as a solution. + solved during the type checking process, :token:`qualid` is used as a solution. Otherwise said, :token:`qualid` is canonically used to extend the field |c_i| into a complete structure built on |c_i|. diff --git a/doc/sphinx/language/gallina-specification-language.rst b/doc/sphinx/language/gallina-specification-language.rst index 8250b4b3d6..075235a8e2 100644 --- a/doc/sphinx/language/gallina-specification-language.rst +++ b/doc/sphinx/language/gallina-specification-language.rst @@ -758,6 +758,7 @@ Simple inductive types the case of annotated inductive types — cf. next section). .. example:: + The set of natural numbers is defined as: .. coqtop:: all @@ -919,7 +920,7 @@ Parametrized inductive types When this option is set (it is off by default), inductive definitions are abstracted over their parameters - before typechecking constructors, allowing to write: + before type checking constructors, allowing to write: .. coqtop:: all undo @@ -976,6 +977,7 @@ Mutually defined inductive types reason, the parameters must be strictly the same for each inductive types. .. example:: + The typical example of a mutual inductive data type is the one for trees and forests. We assume given two types :g:`A` and :g:`B` as variables. It can be declared the following way. @@ -1048,6 +1050,7 @@ of the type. For co-inductive types, the only elimination principle is case analysis. .. example:: + An example of a co-inductive type is the type of infinite sequences of natural numbers, usually called streams. @@ -1067,6 +1070,7 @@ Definition of co-inductive predicates and blocks of mutually co-inductive definitions are also allowed. .. example:: + An example of a co-inductive predicate is the extensional equality on streams: @@ -1120,7 +1124,7 @@ constructions. arguments, and this choice influences the reduction of the fixpoint. Hence an explicit annotation must be used if the leftmost decreasing argument is not the desired one. Writing explicit annotations can also - speed up type-checking of large mutual fixpoints. + speed up type checking of large mutual fixpoints. + In order to keep the strong normalization property, the fixed point reduction will only be performed when the argument in position of the @@ -1129,6 +1133,7 @@ constructions. .. example:: + One can define the addition function as : .. coqtop:: all @@ -1201,6 +1206,7 @@ constructions. inductive types. .. example:: + The size of trees and forests can be defined the following way: .. coqtop:: all diff --git a/doc/sphinx/practical-tools/coq-commands.rst b/doc/sphinx/practical-tools/coq-commands.rst index ad1f0caa60..9498f37c7e 100644 --- a/doc/sphinx/practical-tools/coq-commands.rst +++ b/doc/sphinx/practical-tools/coq-commands.rst @@ -25,7 +25,7 @@ In the interactive mode, also known as the |Coq| toplevel, the user can develop his theories and proofs step by step. The |Coq| toplevel is run by the command ``coqtop``. -They are two different binary images of |Coq|: the byte-code one and the +There are two different binary images of |Coq|: the byte-code one and the native-code one (if OCaml provides a native-code compiler for your platform, which is supposed in the following). By default, ``coqtop`` executes the native-code version; run ``coqtop.byte`` to get @@ -43,10 +43,11 @@ The ``coqc`` command takes a name *file* as argument. Then it looks for a vernacular file named *file*.v, and tries to compile it into a *file*.vo file (See :ref:`compiled-files`). -.. caution:: The name *file* should be a - regular |Coq| identifier, as defined in Section :ref:'TODO-1.1'. It should contain - only letters, digits or underscores (_). For instance, ``/bar/foo/toto.v`` is valid, but - ``/bar/foo/to-to.v`` is invalid. +.. caution:: + + The name *file* should be a regular |Coq| identifier as defined in Section :ref:`lexical-conventions`. + It should contain only letters, digits or underscores (_). For example ``/bar/foo/toto.v`` is valid, + but ``/bar/foo/to-to.v`` is not. Customization at launch time @@ -59,8 +60,8 @@ When |Coq| is launched, with either ``coqtop`` or ``coqc``, the resource file ``$XDG_CONFIG_HOME/coq/coqrc.xxx``, if it exists, will be implicitly prepended to any document read by Coq, whether it is an interactive session or a file to compile. Here, ``$XDG_CONFIG_HOME`` -is the configuration directory of the user (by default its home -directory ``~/.config``) and ``xxx`` is the version number (e.g. 8.8). If +is the configuration directory of the user (by default it's ``~/.config``) +and ``xxx`` is the version number (e.g. 8.8). If this file is not found, then the file ``$XDG_CONFIG_HOME/coqrc`` is searched. If not found, it is the file ``~/.coqrc.xxx`` which is searched, and, if still not found, the file ``~/.coqrc``. If the latter is also @@ -89,8 +90,8 @@ not set, they look for the commands in the executable path. The ``$COQ_COLORS`` environment variable can be used to specify the set of colors used by ``coqtop`` to highlight its output. It uses the same syntax as the ``$LS_COLORS`` variable from GNU’s ls, that is, a colon-separated -list of assignments of the form ``name=``:n:``{*; attr}`` where -``name`` is the name of the corresponding highlight tag and each ``attrᵢ`` is an +list of assignments of the form :n:`name={*; attr}` where +``name`` is the name of the corresponding highlight tag and each ``attr`` is an ANSI escape code. The list of highlight tags can be retrieved with the ``-list-tags`` command-line option of ``coqtop``. @@ -103,10 +104,14 @@ The following command-line options are recognized by the commands ``coqc`` and ``coqtop``, unless stated otherwise: :-I *directory*, -include *directory*: Add physical path *directory* - to the OCaml loadpath. See also: :ref:`names-of-libraries` and the - command Declare ML Module Section :ref:`compiled-files`. + to the OCaml loadpath. + + .. seealso:: + + :ref:`names-of-libraries` and the + command Declare ML Module Section :ref:`compiled-files`. :-Q *directory* dirpath: Add physical path *directory* to the list of - directories where |Coq| looks for a file and bind it to the the logical + directories where |Coq| looks for a file and bind it to the logical directory *dirpath*. The subdirectory structure of *directory* is recursively available from |Coq| using absolute names (extending the dirpath prefix) (see Section :ref:`qualified-names`).Note that only those @@ -114,14 +119,17 @@ and ``coqtop``, unless stated otherwise: an :n:`@ident` are taken into account. Conversely, the underlying file systems or operating systems may be more restrictive than |Coq|. While Linux’s ext4 file system supports any |Coq| recursive - layout (within the limit of 255 bytes per file name), the default on + layout (within the limit of 255 bytes per filename), the default on NTFS (Windows) or HFS+ (MacOS X) file systems is on the contrary to disallow two files differing only in the case in the same directory. - See also: Section :ref:`names-of-libraries`. + + .. seealso:: Section :ref:`names-of-libraries`. :-R *directory* dirpath: Do as -Q *directory* dirpath but make the subdirectory structure of *directory* recursively visible so that the recursive contents of physical *directory* is available from |Coq| using - short or partially qualified names. See also: Section :ref:`names-of-libraries`. + short or partially qualified names. + + .. seealso:: Section :ref:`names-of-libraries`. :-top dirpath: Set the toplevel module name to dirpath instead of Top. Not valid for `coqc` as the toplevel module name is inferred from the name of the output file. @@ -140,15 +148,15 @@ and ``coqtop``, unless stated otherwise: :-l *file*, -load-vernac-source *file*: Load and execute the |Coq| script from *file.v*. :-lv *file*, -load-vernac-source-verbose *file*: Load and execute the - |Coq| script from *file.v*. Output its content on the standard input as + |Coq| script from *file.v*. Write its contents to the standard output as it is executed. :-load-vernac-object dirpath: Load |Coq| compiled library dirpath. This is equivalent to runningRequire dirpath. :-require dirpath: Load |Coq| compiled library dirpath and import it. This is equivalent to running Require Import dirpath. :-batch: Exit just after argument parsing. Available for `coqtop` only. -:-compile *file.v*: Compile file *file.v* into *file.vo*. This options - imply -batch (exit just after argument parsing). It is available only +:-compile *file.v*: Compile file *file.v* into *file.vo*. This option + implies -batch (exit just after argument parsing). It is available only for `coqtop`, as this behavior is the purpose of `coqc`. :-compile-verbose *file.v*: Same as -compile but also output the content of *file.v* as it is compiled. @@ -167,11 +175,16 @@ and ``coqtop``, unless stated otherwise: :-emacs, -ide-slave: Start a special toplevel to communicate with a specific IDE. :-impredicative-set: Change the logical theory of |Coq| by declaring the - sort Set impredicative. Warning: This is known to be inconsistent with some - standard axioms of classical mathematics such as the functional - axiom of choice or the principle of description. -:-type-in-type: Collapse the universe hierarchy of |Coq|. Warning: This makes the logic - inconsistent. + sort Set impredicative. + + .. warning:: + + This is known to be inconsistent with some + standard axioms of classical mathematics such as the functional + axiom of choice or the principle of description. +:-type-in-type: Collapse the universe hierarchy of |Coq|. + + .. warning:: This makes the logic inconsistent. :-mangle-names *ident*: Experimental: Do not depend on this option. Replace Coq's auto-generated name scheme with names of the form *ident0*, *ident1*, etc. The command ``Set Mangle Names`` turns the behavior on in a document, @@ -207,7 +220,7 @@ The ``coqchk`` command takes a list of library paths as argument, described eith by their logical name or by their physical filename, hich must end in ``.vo``. The corresponding compiled libraries (``.vo`` files) are searched in the path, recursively processing the libraries they depend on. The content of all these -libraries is then type-checked. The effect of ``coqchk`` is only to return with +libraries is then type checked. The effect of ``coqchk`` is only to return with normal exit code in case of success, and with positive exit code if an error has been found. Error messages are not deemed to help the user understand what is wrong. In the current version, it does not modify the compiled libraries to mark @@ -237,7 +250,7 @@ relative paths in object files ``-Q`` and ``-R`` have exactly the same meaning. unless explicitly required. :-o: At exit, print a summary about the context. List the names of all assumptions and variables (constants without body). -:-silent: Do not write progress information in standard output. +:-silent: Do not write progress information to the standard output. Environment variable ``$COQLIB`` can be set to override the location of the standard library. @@ -247,15 +260,15 @@ the following: assuming that ``coqchk`` is called with argument ``M``, option ``-norec N``, and ``-admit A``. Let us write :math:`\overline{S}` for the set of reflexive transitive dependencies of set :math:`S`. Then: -+ Modules :math:`C = \overline{M} \backslash \overline{A} \cup M \cup N` are loaded and type-checked before being added ++ Modules :math:`C = \overline{M} \backslash \overline{A} \cup M \cup N` are loaded and type checked before being added to the context. + And :math:`M \cup N \backslash C` is the set of modules that are loaded and added to the - context without type-checking. Basic integrity checks (checksums) are + context without type checking. Basic integrity checks (checksums) are nonetheless performed. -As a rule of thumb, the -admit can be used to tell that some libraries +As a rule of thumb, -admit can be used to tell Coq that some libraries have already been checked. So ``coqchk A B`` can be split in ``coqchk A`` && -``coqchk B -admit A`` without type-checking any definition twice. Of +``coqchk B -admit A`` without type checking any definition twice. Of course, the latter is slightly slower since it makes more disk access. It is also less secure since an attacker might have replaced the compiled library ``A`` after it has been read by the first command, but diff --git a/doc/sphinx/practical-tools/coqide.rst b/doc/sphinx/practical-tools/coqide.rst index f9903e6104..bc6a074a27 100644 --- a/doc/sphinx/practical-tools/coqide.rst +++ b/doc/sphinx/practical-tools/coqide.rst @@ -12,7 +12,7 @@ file, executing corresponding commands or undoing them respectively. |CoqIDE| is run by typing the command `coqide` on the command line. Without argument, the main screen is displayed with an “unnamed -buffer”, and with a file name as argument, another buffer displaying +buffer”, and with a filename as argument, another buffer displaying the contents of that file. Additionally, `coqide` accepts the same options as `coqtop`, given in :ref:`thecoqcommands`, the ones having obviously no meaning for |CoqIDE| being ignored. @@ -27,7 +27,7 @@ is shown in the figure :ref:`CoqIDE main screen <coqide_mainscreen>`. At the top is a menu bar, and a tool bar below it. The large window on the left is displaying the various *script buffers*. The upper right window is the *goal window*, where -goals to prove are displayed. The lower right window is the *message +goals to be proven are displayed. The lower right window is the *message window*, where various messages resulting from commands are displayed. At the bottom is the status bar. @@ -62,8 +62,8 @@ In the figure :ref:`CoqIDE main screen <coqide_mainscreen>`, the running buffer is `Fermat.v`, all commands until the ``Theorem`` have been already executed, and the user tried to go forward executing ``Induction n``. That command failed because no such -tactic exists (tactics are now in lowercase…), and the wrong word is -underlined. +tactic exists (names of standard tactics are written in lowercase), +and the failing command is underlined. Notice that the processed part of the running buffer is not editable. If you ever want to modify something you have to go backward using the up @@ -82,8 +82,8 @@ background in the error background color (pink by default). The same characterization of error-handling applies when running several commands using the "goto" button. -If you ever try to execute a command which happens to run during a -long time, and would like to abort it before its termination, you may +If you ever try to execute a command that runs for a long time +and would like to abort it before it terminates, you may use the interrupt button (the white cross on a red circle). There are other buttons on the |CoqIDE| toolbar: a button to save the running @@ -92,7 +92,7 @@ buffers (left and right arrows); an "information" button; and a "gears" button. The "information" button is described in Section :ref:`try-tactics-automatically`. -The "gears" button submits proof terms to the |Coq| kernel for type-checking. +The "gears" button submits proof terms to the |Coq| kernel for type checking. When |Coq| uses asynchronous processing (see Chapter :ref:`asynchronousandparallelproofprocessing`), proofs may have been completed without kernel-checking of generated proof terms. The presence of unchecked proof terms is indicated by ``Qed`` statements that @@ -141,11 +141,10 @@ Vernacular commands, templates The Templates menu allows using shortcuts to insert vernacular commands. This is a nice way to proceed if you are not sure of the -spelling of the command you want. +syntax of the command you want. -Moreover, this menu offers some *templates* which will automatic -insert a complex command like ``Fixpoint`` with a convenient shape for its -arguments. +Moreover, from this menu you can automatically insert templates of complex +commands like ``Fixpoint`` that you can conveniently fill afterwards. Queries ------------ @@ -177,7 +176,7 @@ The `Compile` menu offers direct commands to: Customizations ------------------- -You may customize your environment using menu Edit/Preferences. A new +You may customize your environment using the menu Edit/Preferences. A new window will be displayed, with several customization sections presented as a notebook. @@ -189,7 +188,7 @@ automatic saving of files, by periodically saving the contents into files named `#f#` for each opened file `f`. You may also activate the *revert* feature: in case a opened file is modified on the disk by a third party, |CoqIDE| may read it again for you. Note that in the case -you edited that same file, you will be prompt to choose to either +you edited that same file, you will be prompted to choose to either discard your changes or not. The File charset encoding choice is described below in :ref:`character-encoding-saved-files`. @@ -209,7 +208,7 @@ Notice that these settings are saved in the file `.coqiderc` of your home directory. A Gtk2 accelerator keymap is saved under the name `.coqide.keys`. It -is not recommanded to edit this file manually: to modify a given menu +is not recommended to edit this file manually: to modify a given menu shortcut, go to the corresponding menu item without releasing the mouse button, press the key you want for the new shortcut, and release the mouse button afterwards. If your system does not allow it, you may @@ -240,14 +239,14 @@ mathematical symbols ∀ and ∃, you may define: There exists a small set of such notations already defined, in the file `utf8.v` of Coq library, so you may enable them just by -``Require utf8`` inside |CoqIDE|, or equivalently, by starting |CoqIDE| with -``coqide -l utf8``. +``Require Import Unicode.Utf8`` inside |CoqIDE|, or equivalently, +by starting |CoqIDE| with ``coqide -l utf8``. However, there are some issues when using such Unicode symbols: you of course need to use a character font which supports them. In the Fonts section of the preferences, the Preview line displays some Unicode symbols, so you could figure out if the selected font is OK. Related -to this, one thing you may need to do is choose whether GTK+ should +to this, one thing you may need to do is choosing whether GTK+ should use antialiased fonts or not, by setting the environment variable `GDK_USE_XFT` to 1 or 0 respectively. diff --git a/doc/sphinx/practical-tools/utilities.rst b/doc/sphinx/practical-tools/utilities.rst index bdaa2aa1a2..218a19c2e5 100644 --- a/doc/sphinx/practical-tools/utilities.rst +++ b/doc/sphinx/practical-tools/utilities.rst @@ -43,7 +43,7 @@ Building a |Coq| project with coq_makefile The majority of |Coq| projects are very similar: a collection of ``.v`` files and eventually some ``.ml`` ones (a |Coq| plugin). The main piece of metadata needed in order to build the project are the command line -options to ``coqc`` (e.g. ``-R``, ``-I``, see also: Section +options to ``coqc`` (e.g. ``-R``, ``-I``, see also: section :ref:`command-line-options`). Collecting the list of files and options is the job of the ``_CoqProject`` file. @@ -107,7 +107,7 @@ decide how to build them. In particular: The use of ``.mlpack`` files has to be preferred over ``.mllib`` files, since it results in a “packed” plugin: All auxiliary modules (as -``Baz`` and ``Bazaux``) are hidden inside the plugin’s “name space” +``Baz`` and ``Bazaux``) are hidden inside the plugin’s "namespace" (``Qux_plugin``). This reduces the chances of begin unable to load two distinct plugins because of a clash in their auxiliary module names. @@ -218,6 +218,7 @@ file timing data: On ``Mac OS``, this works best if you’ve installed ``gnu-time``. .. example:: + For example, the output of ``make TIMED=1`` may look like this: @@ -295,6 +296,7 @@ file timing data: files which take effectively no time to compile. .. example:: + For example, the output table from ``make print-pretty-timed-diff`` may look like this: @@ -318,6 +320,7 @@ line timing data: line-by-line timing information. .. example:: + For example, running ``make all TIMING=1`` may result in a file like this: :: @@ -345,6 +348,7 @@ line timing data: This target requires python to build the table. .. example:: + For example, running ``print-pretty-single-time-diff`` might give a table like this: :: @@ -434,7 +438,7 @@ To build, say, two targets foo.vo and bar.vo in parallel one can use For users of coq_makefile with version < 8.7 - + Support for “sub-directory” is deprecated. To perform actions before + + Support for "subdirectory" is deprecated. To perform actions before or after the build (like invoking ``make`` on a subdirectory) one can hook in pre-all and post-all extension points. + ``-extra-phony`` and ``-extra`` are deprecated. To provide additional target @@ -442,10 +446,10 @@ To build, say, two targets foo.vo and bar.vo in parallel one can use -Modules dependencies +Module dependencies -------------------- -In order to compute modules dependencies (so to use ``make``), |Coq| comes +In order to compute module dependencies (so to use ``make``), |Coq| comes with an appropriate tool, ``coqdep``. ``coqdep`` computes inter-module dependencies for |Coq| and |OCaml| @@ -460,7 +464,7 @@ command ``Declare ML Module``. Dependencies of |OCaml| modules are computed by looking at `open` commands and the dot notation *module.value*. However, this is done approximately and you are advised to use ``ocamldep`` instead for the -|OCaml| modules dependencies. +|OCaml| module dependencies. See the man page of ``coqdep`` for more details and options. @@ -478,9 +482,9 @@ coqdoc is a documentation tool for the proof assistant |Coq|, similar to ``javadoc`` or ``ocamldoc``. The task of coqdoc is -#. to produce a nice |Latex| and/or HTML document from the |Coq| - sources, readable for a human and not only for the proof assistant; -#. to help the user navigating in his own (or third-party) sources. +#. to produce a nice |Latex| and/or HTML document from |Coq| source files, + readable for a human and not only for the proof assistant; +#. to help the user navigate his own (or third-party) sources. @@ -491,7 +495,7 @@ Documentation is inserted into |Coq| files as *special comments*. Thus your files will compile as usual, whether you use coqdoc or not. coqdoc presupposes that the given |Coq| files are well-formed (at least lexically). Documentation starts with ``(**``, followed by a space, and -ends with the pending ``*)``. The documentation format is inspired by Todd +ends with ``*)``. The documentation format is inspired by Todd A. Coram’s *Almost Free Text (AFT)* tool: it is mainly ``ASCII`` text with some syntax-light controls, described below. coqdoc is robust: it shouldn’t fail, whatever the input is. But remember: “garbage in, @@ -507,7 +511,7 @@ quoted code (thus you can quote a term like ``fun x => u`` by writing ``[fun x => u]``). Inside quotations, the code is pretty-printed in the same way as it is in code parts. -Pre-formatted vernacular is enclosed by ``[[`` and ``]]``. The former must be +Preformatted vernacular is enclosed by ``[[`` and ``]]``. The former must be followed by a newline and the latter must follow a newline. @@ -533,7 +537,7 @@ or It gives the |Latex| and HTML texts to be produced for the given |Coq| -token. One of the |Latex| or HTML text may be omitted, causing the +token. Either the |Latex| or the HTML rule may be omitted, causing the default pretty-printing to be used for this token. The printing for one token can be removed with @@ -546,12 +550,12 @@ The printing for one token can be removed with Initially, the pretty-printing table contains the following mapping: -==== === ==== ===== === ==== ==== === -`->` → `<-` ← `*` × -`<=` ≤ `>=` ≥ `=>` ⇒ -`<>` ≠ `<->` ↔ `|-` ⊢ -`\/` ∨ `/\\` ∧ `~` ¬ -==== === ==== ===== === ==== ==== === +===== === ==== ===== === ==== ==== === +`->` → `<-` ← `*` × +`<=` ≤ `>=` ≥ `=>` ⇒ +`<>` ≠ `<->` ↔ `|-` ⊢ +`\\/` ∨ `/\\` ∧ `~` ¬ +===== === ==== ===== === ==== ==== === Any of these can be overwritten or suppressed using the printing commands. @@ -573,10 +577,9 @@ commands. Sections ++++++++ -Sections are introduced by 1 to 4 leading stars (i.e. at the beginning -of the line) followed by a space. One star is a section, two stars a -sub-section, etc. The section title is given on the remaining of the -line. +Sections are introduced by 1 to 4 asterisks at the beginning of a line +followed by a space and the title of the section. One asterisk is a section, +two a subsection, etc. .. example:: @@ -624,7 +627,7 @@ More than 4 leading dashes produce a horizontal rule. Emphasis. +++++++++ -Text can be italicized by placing it in underscores. A non-identifier +Text can be italicized by enclosing it in underscores. A non-identifier character must precede the leading underscore and follow the trailing underscore, so that uses of underscores in names aren’t mistaken for emphasis. Usually, these are spaces or punctuation. @@ -679,16 +682,16 @@ Hyperlinks can be inserted into the HTML output, so that any identifier is linked to the place of its definition. ``coqc file.v`` automatically dumps localization information in -``file.glob`` or appends it to a file specified using option ``--dump-glob +``file.glob`` or appends it to a file specified using the option ``--dump-glob file``. Take care of erasing this global file, if any, when starting the whole compilation process. Then invoke coqdoc or ``coqdoc --glob-from file`` to tell coqdoc to look -for name resolutions into the file ``file`` (it will look in ``file.glob`` +for name resolutions in the file ``file`` (it will look in ``file.glob`` by default). -Identifiers from the |Coq| standard library are linked to the Coq web -site at `<http://coq.inria.fr/library/>`_. This behavior can be changed +Identifiers from the |Coq| standard library are linked to the Coq website +`<http://coq.inria.fr/library/>`_. This behavior can be changed using command line options ``--no-externals`` and ``--coqlib``; see below. @@ -731,12 +734,12 @@ file (even if it starts with a ``-``). |Coq| files are identified by the suffixes ``.v`` and ``.g`` and |Latex| files by the suffix ``.tex``. -:HTML output: This is the default output. One HTML file is created for +:HTML output: This is the default output format. One HTML file is created for each |Coq| file given on the command line, together with a file ``index.html`` (unless ``option-no-index is passed``). The HTML pages use a style sheet named ``style.css``. Such a file is distributed with coqdoc. :|Latex| output: A single |Latex| file is created, on standard - output. It can be redirected to a file with option ``-o``. The order of + output. It can be redirected to a file using the option ``-o``. The order of files on the command line is kept in the final document. |Latex| files given on the command line are copied ‘as is’ in the final document . DVI and PostScript can be produced directly with the @@ -762,15 +765,15 @@ Command line options :-o file, --output file: Redirect the output into the file ‘file’ (meaningless with ``-html``). :-d dir, --directory dir: Output files into directory ‘dir’ instead of - current directory (option ``-d`` does not change the filename specified - with option ``-o``, if any). + the current directory (option ``-d`` does not change the filename specified + with the option ``-o``, if any). :--body-only: Suppress the header and trailer of the final document. Thus, you can insert the resulting document into a larger one. :-p string, --preamble string: Insert some material in the |Latex| preamble, right before ``\begin{document}`` (meaningless with ``-html``). :--vernac-file file,--tex-file file: Considers the file ‘file’ respectively as a ``.v`` (or ``.g``) file or a ``.tex`` file. - :--files-from file: Read file names to process in file ‘file’ as if + :--files-from file: Read filenames to be processed from the file ‘file’ as if they were given on the command line. Useful for program sources split up into several directories. :-q, --quiet: Be quiet. Do not print anything except errors. @@ -781,7 +784,7 @@ Command line options **Index options** - Default behavior is to build an index, for the HTML output only, + The default behavior is to build an index, for the HTML output only, into ``index.html``. :--no-index: Do not output the index. @@ -802,7 +805,7 @@ Command line options contents. -**Hyperlinks options** +**Hyperlink options** :--glob-from file: Make references using |Coq| globalizations from file file. (Such globalizations are obtained with Coq option ``-dump-glob``). @@ -858,9 +861,9 @@ Command line options The behavior of options ``-g`` and ``-l`` can be locally overridden using the ``(* begin show *) … (* end show *)`` environment (see above). - There are a few options to drive the parsing of comments: + There are a few options that control the parsing of comments: - :--parse-comments: Parses regular comments delimited by ``(*`` and ``*)`` as + :--parse-comments: Parse regular comments delimited by ``(*`` and ``*)`` as well. They are typeset inline. :--plain-comments: Do not interpret comments, simply copy them as plain-text. @@ -870,7 +873,7 @@ Command line options **Language options** - Default behavior is to assume ASCII 7 bits input files. + The default behavior is to assume ASCII 7 bit input files. :-latin1, --latin1: Select ISO-8859-1 input files. It is equivalent to --inputenc latin1 --charset iso-8859-1. @@ -935,7 +938,7 @@ macros: Embedded Coq phrases inside |Latex| documents --------------------------------------------- -When writing a documentation about a proof development, one may want +When writing documentation about a proof development, one may want to insert |Coq| phrases inside a |Latex| document, possibly together with the corresponding answers of the system. We provide a mechanical way to process such |Coq| phrases embedded in |Latex| files: the ``coq-tex`` diff --git a/doc/sphinx/proof-engine/detailed-tactic-examples.rst b/doc/sphinx/proof-engine/detailed-tactic-examples.rst index bb2a8741e2..72dd79d930 100644 --- a/doc/sphinx/proof-engine/detailed-tactic-examples.rst +++ b/doc/sphinx/proof-engine/detailed-tactic-examples.rst @@ -21,7 +21,7 @@ applied to the abstracted instance and after simplification of the equalities we get the expected goals. The abstracting tactic is called generalize_eqs and it takes as -argument an hypothesis to generalize. It uses the JMeq datatype +argument a hypothesis to generalize. It uses the JMeq datatype defined in Coq.Logic.JMeq, hence we need to require it before. For example, revisiting the first example of the inversion documentation: @@ -341,8 +341,7 @@ involves conditional rewritings and shows how to deal with them using the optional tactic of the ``Hint Rewrite`` command. -.. example:: - Ackermann function +.. example:: Ackermann function .. coqtop:: in reset @@ -370,8 +369,7 @@ the optional tactic of the ``Hint Rewrite`` command. autorewrite with base0 using try reflexivity. -.. example:: - MacCarthy function +.. example:: MacCarthy function .. coqtop:: in reset diff --git a/doc/sphinx/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst index dc355fa013..7608ea7245 100644 --- a/doc/sphinx/proof-engine/ltac.rst +++ b/doc/sphinx/proof-engine/ltac.rst @@ -144,10 +144,11 @@ mode but it can also be used in toplevel definitions as shown below. : | `integer` (< | <= | > | >=) `integer` selector : [`ident`] : | `integer` - : (`integer` | `integer` - `integer`), ..., (`integer` | `integer` - `integer`) + : | (`integer` | `integer` - `integer`), ..., (`integer` | `integer` - `integer`) toplevel_selector : `selector` - : | `all` - : | `par` + : | all + : | par + : | ! .. productionlist:: coq top : [Local] Ltac `ltac_def` with ... with `ltac_def` @@ -177,7 +178,7 @@ Sequence A sequence is an expression of the following form: -.. tacn:: @expr ; @expr +.. tacn:: @expr__1 ; @expr__2 :name: ltac-seq The expression :n:`@expr__1` is evaluated to :n:`v__1`, which must be @@ -207,11 +208,11 @@ following form: were given. For instance, ``[> | auto]`` is a shortcut for ``[> idtac | auto ]``. - .. tacv:: [> {*| @expr} | @expr .. | {*| @expr}] + .. tacv:: [> {*| @expr__i} | @expr .. | {*| @expr__j}] - In this variant, token:`expr` is used for each goal coming after those - covered by the first list of :n:`@expr` but before those coevered by the - last list of :n:`@expr`. + In this variant, :n:`@expr` is used for each goal coming after those + covered by the list of :n:`@expr__i` but before those covered by the + list of :n:`@expr__j`. .. tacv:: [> {*| @expr} | .. | {*| @expr}] @@ -225,11 +226,11 @@ following form: tactic is not run at all. A tactic which expects multiple goals, such as ``swap``, would act as if a single goal is focused. - .. tacv:: expr ; [{*| @expr}] + .. tacv:: @expr__0 ; [{*| @expr__i}] This variant of local tactic application is paired with a sequence. In this - variant, there must be as many :n:`@expr` in the list as goals generated - by the application of the first :n:`@expr` to each of the individual goals + variant, there must be as many :n:`@expr__i` as goals generated + by the application of :n:`@expr__0` to each of the individual goals independently. All the above variants work in this form too. Formally, :n:`@expr ; [ ... ]` is equivalent to :n:`[> @expr ; [> ... ] .. ]`. @@ -247,20 +248,20 @@ focused goals with: We can also use selectors as a tactical, which allows to use them nested in a tactic expression, by using the keyword ``only``: - .. tacv:: only selector : expr + .. tacv:: only @selector : @expr :name: only ... : ... - When selecting several goals, the tactic expr is applied globally to all + When selecting several goals, the tactic :token:`expr` is applied globally to all selected goals. .. tacv:: [@ident] : @expr - In this variant, :n:`@expr` is applied locally to a goal previously named + In this variant, :token:`expr` is applied locally to a goal previously named by the user (see :ref:`existential-variables`). .. tacv:: @num : @expr - In this variant, :n:`@expr` is applied locally to the :token:`num`-th goal. + In this variant, :token:`expr` is applied locally to the :token:`num`-th goal. .. tacv:: {+, @num-@num} : @expr @@ -271,13 +272,13 @@ focused goals with: .. tacv:: all: @expr :name: all: ... - In this variant, :n:`@expr` is applied to all focused goals. ``all:`` can only + In this variant, :token:`expr` is applied to all focused goals. ``all:`` can only be used at the toplevel of a tactic expression. .. tacv:: !: @expr - In this variant, if exactly one goal is focused :n:`expr` is - applied to it. Otherwise the tactical fails. ``!:`` can only be + In this variant, if exactly one goal is focused, :token:`expr` is + applied to it. Otherwise the tactic fails. ``!:`` can only be used at the toplevel of a tactic expression. .. tacv:: par: @expr @@ -390,7 +391,7 @@ tactic to work (i.e. which does not fail) among a panel of tactics: focused goal independently and stops if it succeeds; otherwise it tries to apply :n:`v__2` and so on. It fails when there is no applicable tactic. In other words, - :n:`first [@expr__1 | ... | @expr__n]` behaves, in each goal, as the the first + :n:`first [@expr__1 | ... | @expr__n]` behaves, in each goal, as the first :n:`v__i` to have *at least* one success. .. exn:: No applicable tactic. @@ -555,9 +556,9 @@ Failing The number is the failure level. If no level is specified, it defaults to 0. The level is used by :tacn:`try`, :tacn:`repeat`, :tacn:`match goal` and the branching tacticals. If 0, it makes :tacn:`match goal` consider the next clause - (backtracking). If non zero, the current :tacn:`match goal` block, :tacn:`try`, + (backtracking). If nonzero, the current :tacn:`match goal` block, :tacn:`try`, :tacn:`repeat`, or branching command is aborted and the level is decremented. In - the case of :n:`+`, a non-zero level skips the first backtrack point, even if + the case of :n:`+`, a nonzero level skips the first backtrack point, even if the call to :n:`fail @num` is not enclosed in a :n:`+` command, respecting the algebraic identity. @@ -862,7 +863,7 @@ We can perform pattern matching on goals using the following expression: :name: match goal If each hypothesis pattern :n:`hyp`\ :sub:`1,i`, with i = 1, ..., m\ :sub:`1` is - matched (non-linear first-order unification) by an hypothesis of the + matched (non-linear first-order unification) by a hypothesis of the goal and if :n:`cpattern_1` is matched by the conclusion of the goal, then :n:`@expr__1` is evaluated to :n:`v__1` by substituting the pattern matching to the metavariables and the real hypothesis names @@ -988,7 +989,7 @@ Manipulating untyped terms An untyped term, in |Ltac|, can contain references to hypotheses or to |Ltac| variables containing typed or untyped terms. An untyped term can be - type-checked using the function type_term whose argument is parsed as an + type checked using the function type_term whose argument is parsed as an untyped term and returns a well-typed term which can be used in tactics. Untyped terms built using :n:`uconstr :` can also be used as arguments to the diff --git a/doc/sphinx/proof-engine/proof-handling.rst b/doc/sphinx/proof-engine/proof-handling.rst index 44376080c3..b1e769c571 100644 --- a/doc/sphinx/proof-engine/proof-handling.rst +++ b/doc/sphinx/proof-engine/proof-handling.rst @@ -84,7 +84,7 @@ list of assertion commands is given in :ref:`Assertions`. The command :name: Defined Same as :cmd:`Qed` but the proof is then declared transparent, which means - that its content can be explicitly used for type-checking and that it can be + that its content can be explicitly used for type checking and that it can be unfolded in conversion tactics (see :ref:`performingcomputations`, :cmd:`Opaque`, :cmd:`Transparent`). @@ -315,6 +315,9 @@ Navigation in the proof tree .. _curly-braces: +.. index:: { + } + .. cmd:: %{ %| %} The command ``{`` (without a terminating period) focuses on the first @@ -329,20 +332,47 @@ Navigation in the proof tree .. cmdv:: @num: %{ - This focuses on the :token:`num` th subgoal to prove. + This focuses on the :token:`num`\-th subgoal to prove. + + .. cmdv:: [@ident]: %{ + + This focuses on the named goal :token:`ident`. + + .. note:: + + Goals are just existential variables and existential variables do not + get a name by default. You can give a name to a goal by using :n:`refine ?[@ident]`. - Error messages: + .. seealso:: :ref:`existential-variables` + + .. example:: + + This can also be a way of focusing on a shelved goal, for instance: + + .. coqtop:: all + + Goal exists n : nat, n = n. + eexists ?[x]. + reflexivity. + [x]: exact 0. + Qed. .. exn:: This proof is focused, but cannot be unfocused this way. You are trying to use ``}`` but the current subproof has not been fully solved. - .. exn:: No such goal. - :name: No such goal. (Focusing) + .. exn:: No such goal (@num). + :undocumented: + + .. exn:: No such goal (@ident). + :undocumented: + + .. exn:: Brackets do not support multi-goal selectors. - .. exn:: Brackets only support the single numbered goal selector. + Brackets are used to focus on a single goal given either by its position + or by its name if it has one. - See also error messages about bullets below. + .. seealso:: The error messages about bullets below. .. _bullets: @@ -358,8 +388,10 @@ same bullet ``b``. See the example below. Different bullets can be used to nest levels. The scope of bullet does not go beyond enclosing ``{`` and ``}``, so bullets can be reused as further -nesting levels provided they are delimited by these. Available bullets -are ``-``, ``+``, ``*``, ``--``, ``++``, ``**``, ``---``, ``+++``, ``***``, ... (without a terminating period). +nesting levels provided they are delimited by these. Bullets are made of +repeated ``-``, ``+`` or ``*`` symbols: + +.. prodn:: bullet ::= {+ - } %| {+ + } %| {+ * } Note again that when a focused goal is proved a message is displayed together with a suggestion about the right bullet or ``}`` to unfocus it @@ -375,6 +407,7 @@ or focus the next one. The following example script illustrates all these features: .. example:: + .. coqtop:: all Goal (((True /\ True) /\ True) /\ True) /\ True. @@ -391,19 +424,23 @@ The following example script illustrates all these features: - assert True. { trivial. } assumption. + Qed. +.. exn:: Wrong bullet @bullet__1: Current bullet @bullet__2 is not finished. -.. exn:: Wrong bullet @bullet1: Current bullet @bullet2 is not finished. + Before using bullet :n:`@bullet__1` again, you should first finish proving + the current focused goal. + Note that :n:`@bullet__1` and :n:`@bullet__2` may be the same. - Before using bullet :n:`@bullet1` again, you should first finish proving the current focused goal. Note that :n:`@bullet1` and :n:`@bullet2` may be the same. +.. exn:: Wrong bullet @bullet__1: Bullet @bullet__2 is mandatory here. -.. exn:: Wrong bullet @bullet1: Bullet @bullet2 is mandatory here. - - You must put :n:`@bullet2` to focus next goal. No other bullet is allowed here. + You must put :n:`@bullet__2` to focus on the next goal. No other bullet is + allowed here. .. exn:: No such goal. Focus next goal with bullet @bullet. - You tried to apply a tactic but no goals were under focus. Using :n:`@bullet` is mandatory here. + You tried to apply a tactic but no goals were under focus. + Using :n:`@bullet` is mandatory here. .. exn:: No such goal. Try unfocusing with %{. @@ -432,7 +469,7 @@ Requesting information .. cmdv:: Show @num - Displays only the :token:`num` th subgoal. + Displays only the :token:`num`\-th subgoal. .. exn:: No such goal. @@ -511,6 +548,7 @@ Requesting information :token:`ident` .. example:: + .. coqtop:: all Show Match nat. diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst index 6fb73a030f..7c3ea1a28c 100644 --- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst +++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst @@ -37,7 +37,7 @@ bookkeeping is performed on the conclusion of the goal, using for that purpose a couple of syntactic constructions behaving similar to tacticals (and often named as such in this chapter). The ``:`` tactical moves hypotheses from the context to the conclusion, while ``=>`` moves hypotheses from the -conclusion to the context, and ``in`` moves back and forth an hypothesis from the +conclusion to the context, and ``in`` moves back and forth a hypothesis from the context to the conclusion for the time of applying an action to it. While naming hypotheses is commonly done by means of an ``as`` clause in the @@ -303,7 +303,7 @@ the ``if`` construct to all binary data types; compare The latter appears to be marginally shorter, but it is quite ambiguous, and indeed often requires an explicit annotation -``(term : {_} + {_})`` to type-check, which evens the character count. +``(term : {_} + {_})`` to type check, which evens the character count. Therefore, |SSR| restricts by default the condition of a plain if construct to the standard ``bool`` type; this avoids spurious type @@ -385,7 +385,7 @@ expressions such as Unfortunately, such higher-order expressions are quite frequent in representation functions, especially those which use |Coq|'s -``Structures`` to emulate Haskell type classes. +``Structures`` to emulate Haskell typeclasses. Therefore, |SSR| provides a variant of |Coq|’s implicit argument declaration, which causes |Coq| to fill in some implicit parameters at @@ -1285,7 +1285,7 @@ catch the appropriate number of wildcards to be inserted. Note that this use of the refine tactic implies that the tactic tries to match the goal up to expansion of constants and evaluation of subterms. -|SSR|’s apply has a special behaviour on goals containing +|SSR|’s apply has a special behavior on goals containing existential metavariables of sort Prop. .. example:: @@ -2064,26 +2064,27 @@ is equivalent to: (see section :ref:`discharge_ssr` for the documentation of the apply: combination). -Warning The list of tactics, possibly chained by semicolons, that -follows a by keyword is considered as a parenthesized block applied to -the current goal. Hence for example if the tactic: +.. warning:: -.. coqtop:: in + The list of tactics (possibly chained by semicolons) that + follows the ``by`` keyword is considered to be a parenthesized block applied to + the current goal. Hence for example if the tactic: - by rewrite my_lemma1. + .. coqtop:: in -succeeds, then the tactic: + by rewrite my_lemma1. -.. coqtop:: in + succeeds, then the tactic: - by rewrite my_lemma1; apply my_lemma2. + .. coqtop:: in -usually fails since it is equivalent to: + by rewrite my_lemma1; apply my_lemma2. -.. coqtop:: in + usually fails since it is equivalent to: - by (rewrite my_lemma1; apply my_lemma2). + .. coqtop:: in + by (rewrite my_lemma1; apply my_lemma2). .. _selectors_ssr: @@ -2522,7 +2523,8 @@ After the :token:`i_pattern`, a list of binders is allowed. .. coqtop:: reset - From Coq Require Import ssreflect Omega. + From Coq Require Import ssreflect. + From Coq Require Import Omega. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -2552,12 +2554,9 @@ copying the goal itself. .. example:: - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. + Abort All. .. coqtop:: all @@ -2581,12 +2580,9 @@ context entry name. .. example:: - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. + Abort All. Set Printing Depth 15. .. coqtop:: all @@ -2601,20 +2597,13 @@ context entry name. Note that the sub-term produced by ``omega`` is in general huge and uninteresting, and hence one may want to hide it. For this purpose the ``[: name ]`` intro pattern and the tactic -``abstract`` (see page :ref:`abstract_ssr`) are provided. +``abstract`` (see :ref:`abstract_ssr`) are provided. .. example:: - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. - - Inductive Ord n := Sub x of x < n. - Notation "'I_ n" := (Ord n) (at level 8, n at level 2, format "''I_' n"). - Arguments Sub {_} _ _. + Abort All. .. coqtop:: all @@ -2629,16 +2618,9 @@ with have and an explicit term, they must be used as follows: .. example:: - .. coqtop:: reset - - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. + .. coqtop:: none - Inductive Ord n := Sub x of x < n. - Notation "'I_ n" := (Ord n) (at level 8, n at level 2, format "''I_' n"). - Arguments Sub {_} _ _. + Abort All. .. coqtop:: all @@ -2659,16 +2641,9 @@ makes use of it). .. example:: - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. - - Inductive Ord n := Sub x of x < n. - Notation "'I_ n" := (Ord n) (at level 8, n at level 2, format "''I_' n"). - Arguments Sub {_} _ _. + Abort All. .. coqtop:: all @@ -2679,18 +2654,15 @@ Last, notice that the use of intro patterns for abstract constants is orthogonal to the transparent flag ``@`` for have. -The have tactic and type classes resolution +The have tactic and typeclass resolution ``````````````````````````````````````````` -Since |SSR| 1.5 the have tactic behaves as follows with respect to -type classes inference. +Since |SSR| 1.5 the ``have`` tactic behaves as follows with respect to +typeclass inference. - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. + Abort All. Axiom ty : Type. Axiom t : ty. @@ -2728,7 +2700,7 @@ type classes inference. .. opt:: SsrHave NoTCResolution - This option restores the behavior of |SSR| 1.4 and below (never resolve type classes). + This option restores the behavior of |SSR| 1.4 and below (never resolve typeclasses). Variants: the suff and wlog tactics ``````````````````````````````````` @@ -2766,12 +2738,9 @@ The ``have`` modifier can follow the ``suff`` tactic. .. example:: - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. + Abort All. Axioms G P : Prop. .. coqtop:: all @@ -2839,12 +2808,9 @@ are unique. .. example:: - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. + Abort All. .. coqtop:: all @@ -2935,12 +2901,10 @@ illustrated in the following example. the pattern ``id (addx x)``, that would produce the following first subgoal - .. coqtop:: reset + .. coqtop:: none - From Coq Require Import ssreflect Omega. - Set Implicit Arguments. - Unset Strict Implicit. - Unset Printing Implicit Defensive. + Abort All. + From Coq Require Import Omega. Section Test. Variable x : nat. Definition addx z := z + x. @@ -3046,6 +3010,15 @@ An :token:`r_item` can be: is equivalent to: ``change term1 with term2.`` If ``term2`` is a single constant and ``term1`` head symbol is not ``term2``, then the head symbol of ``term1`` is repeatedly unfolded until ``term2`` appears. ++ A :token:`term`, which can be: + + A term whose type has the form: + ``forall (x1 : A1 )…(xn : An ), eq term1 term2`` where + ``eq`` is the Leibniz equality or a registered setoid + equality. + + A list of terms ``(t1 ,…,tn)``, each ``ti`` having a type above. + The tactic: ``rewrite r_prefix (t1 ,…,tn ).`` + is equivalent to: ``do [rewrite r_prefix t1 | … | rewrite r_prefix tn ].`` + + An anonymous rewrite lemma ``(_ : term)``, where term has a type as above. tactic: ``rewrite (_ : term)`` is in fact synonym of: ``cutrewrite (term).``. .. example:: @@ -3063,9 +3036,10 @@ An :token:`r_item` can be: Lemma test x : ddouble x = 4 * x. rewrite [ddouble _]/double. - *Warning* The |SSR| - terms containing holes are *not* typed as abstractions in this - context. Hence the following script fails. + .. warning:: + + The |SSR| terms containing holes are *not* typed as + abstractions in this context. Hence the following script fails. .. coqtop:: none @@ -3087,17 +3061,6 @@ An :token:`r_item` can be: rewrite -[f y x]/(y + _). -+ A :token:`term`, which can be: - - + A term whose type has the form: - ``forall (x1 : A1 )…(xn : An ), eq term1 term2`` where - ``eq`` is the Leibniz equality or a registered setoid - equality. - + A list of terms ``(t1 ,…,tn)``, each ``ti`` having a type above. - The tactic: ``rewrite r_prefix (t1 ,…,tn ).`` - is equivalent to: ``do [rewrite r_prefix t1 | … | rewrite r_prefix tn ].`` - + An anonymous rewrite lemma ``(_ : term)``, where term has a type as above. tactic: ``rewrite (_ : term)`` is in fact synonym of: ``cutrewrite (term).``. - Remarks and examples ~~~~~~~~~~~~~~~~~~~~ @@ -3738,20 +3701,22 @@ Note that ``nosimpl bar`` is simply notation for a term that reduces to ``bar``; hence ``unfold foo`` will replace ``foo`` by ``bar``, and ``fold foo`` will replace ``bar`` by ``foo``. -*Warning* The ``nosimpl`` trick only works if no reduction is apparent in -``t``; in particular, the declaration: +.. warning:: -.. coqtop:: in + The ``nosimpl`` trick only works if no reduction is apparent in + ``t``; in particular, the declaration: - Definition foo x := nosimpl (bar x). + .. coqtop:: in -will usually not work. Anyway, the common practice is to tag only the -function, and to use the following definition, which blocks the -reduction as expected: + Definition foo x := nosimpl (bar x). -.. coqtop:: in + will usually not work. Anyway, the common practice is to tag only the + function, and to use the following definition, which blocks the + reduction as expected: - Definition foo x := nosimpl bar x. + .. coqtop:: in + + Definition foo x := nosimpl bar x. A standard example making this technique shine is the case of arithmetic operations. We define for instance: @@ -4632,6 +4597,7 @@ bookkeeping steps. .. example:: + The following example use the ``~~`` prenex notation for boolean negation: @@ -4793,7 +4759,7 @@ equivalence property has been defined. Lemma andE (b1 b2 : bool) : (b1 /\ b2) <-> (b1 && b2). -Let us compare the respective behaviours of ``andE`` and ``andP``. +Let us compare the respective behaviors of ``andE`` and ``andP``. .. example:: @@ -4906,7 +4872,7 @@ The term , called the *view lemma* can be: Let ``top`` be the top assumption in the goal. -There are three steps in the behaviour of an assumption view tactic: +There are three steps in the behavior of an assumption view tactic: + It first introduces ``top``. + If the type of :token:`term` is neither a double implication nor an diff --git a/doc/sphinx/proof-engine/tactics.rst b/doc/sphinx/proof-engine/tactics.rst index 9b4d724e02..241cdf5eea 100644 --- a/doc/sphinx/proof-engine/tactics.rst +++ b/doc/sphinx/proof-engine/tactics.rst @@ -113,26 +113,26 @@ Occurrence sets and occurrence clauses An occurrence clause is a modifier to some tactics that obeys the following syntax: -.. _tactic_occurence_grammar: - .. productionlist:: `sentence` - occurence_clause : in `goal_occurences` - goal_occurences : [ident [`at_occurences`], ... , ident [`at_occurences`] [|- [* [`at_occurences`]]]] - :| * |- [* [`at_occurences`]] + occurrence_clause : in `goal_occurrences` + goal_occurrences : [`ident` [`at_occurrences`], ... , ident [`at_occurrences`] [|- [* [`at_occurrences`]]]] + :| * |- [* [`at_occurrences`]] :| * at_occurrences : at `occurrences` - occurences : [-] `num` ... `num` - -The role of an occurrence clause is to select a set of occurrences of a term in -a goal. In the first case, the :n:`@ident {? at {* num}}` parts indicate that -occurrences have to be selected in the hypotheses named :n:`@ident`. If no -numbers are given for hypothesis :n:`@ident`, then all the occurrences of `term` -in the hypothesis are selected. If numbers are given, they refer to occurrences -of `term` when the term is printed using option :opt:`Printing All`, counting -from left to right. In particular, occurrences of `term` in implicit arguments -(see :ref:`ImplicitArguments`) or coercions (see :ref:`Coercions`) are counted. - -If a minus sign is given between at and the list of occurrences, it + occurrences : [-] `num` ... `num` + +The role of an occurrence clause is to select a set of occurrences of a term +in a goal. In the first case, the :n:`@ident {? at {* num}}` parts indicate +that occurrences have to be selected in the hypotheses named :token:`ident`. +If no numbers are given for hypothesis :token:`ident`, then all the +occurrences of :token:`term` in the hypothesis are selected. If numbers are +given, they refer to occurrences of :token:`term` when the term is printed +using option :opt:`Printing All`, counting from left to right. In particular, +occurrences of :token:`term` in implicit arguments +(see :ref:`ImplicitArguments`) or coercions (see :ref:`Coercions`) are +counted. + +If a minus sign is given between ``at`` and the list of occurrences, it negates the condition so that the clause denotes all the occurrences except the ones explicitly mentioned after the minus sign. @@ -146,18 +146,20 @@ of term are selected in every hypothesis. In the first and second case, if ``*`` is mentioned on the right of ``|-``, the occurrences of the conclusion of the goal have to be selected. If some numbers are given, then only the occurrences denoted by these numbers are selected. If -no numbers are given, all occurrences of :n:`@term` in the goal are selected. +no numbers are given, all occurrences of :token:`term` in the goal are selected. Finally, the last notation is an abbreviation for ``* |- *``. Note also that ``|-`` is optional in the first case when no ``*`` is given. -Here are some tactics that understand occurrence clauses: :tacn:`set`, :tacn:`remember` -, :tacn:`induction`, :tacn:`destruct`. +Here are some tactics that understand occurrence clauses: :tacn:`set`, +:tacn:`remember`, :tacn:`induction`, :tacn:`destruct`. + + +.. seealso:: + :ref:`Managingthelocalcontext`, :ref:`caseanalysisandinduction`, + :ref:`printing_constructions_full`. -See also: :ref:`Managingthelocalcontext`, -:ref:`caseanalysisandinduction`, -:ref:`printing_constructions_full`. .. _applyingtheorems: @@ -173,40 +175,45 @@ Applying theorems :ref:`Conversion-rules`). .. exn:: Not an exact proof. + :undocumented: .. tacv:: eexact @term. :name: eexact - This tactic behaves like exact but is able to handle terms and goals with - meta-variables. + This tactic behaves like :tacn:`exact` but is able to handle terms and + goals with existential variables. .. tacn:: assumption :name: assumption - This tactic looks in the local context for an hypothesis which type is equal to - the goal. If it is the case, the subgoal is proved. Otherwise, it fails. + This tactic looks in the local context for a hypothesis whose type is + convertible to the goal. If it is the case, the subgoal is proved. + Otherwise, it fails. .. exn:: No such assumption. + :undocumented: .. tacv:: eassumption :name: eassumption - This tactic behaves like assumption but is able to handle goals with - meta-variables. + This tactic behaves like :tacn:`assumption` but is able to handle + goals with existential variables. .. tacn:: refine @term :name: refine This tactic applies to any goal. It behaves like :tacn:`exact` with a big - difference: the user can leave some holes (denoted by ``_`` or ``(_:type)``) in - the term. :tacn:`refine` will generate as many subgoals as there are holes in - the term. The type of holes must be either synthesized by the system - or declared by an explicit cast like ``(_:nat->Prop)``. Any subgoal that + difference: the user can leave some holes (denoted by ``_`` + or :n:`(_ : @type)`) in the term. :tacn:`refine` will generate as many + subgoals as there are holes in the term. The type of holes must be either + synthesized by the system or declared by an explicit cast + like ``(_ : nat -> Prop)``. Any subgoal that occurs in other subgoals is automatically shelved, as if calling :tacn:`shelve_unifiable`. This low-level tactic can be useful to advanced users. .. example:: + .. coqtop:: reset all Inductive Option : Set := @@ -214,16 +221,13 @@ Applying theorems | Ok : bool -> Option. Definition get : forall x:Option, x <> Fail -> bool. - - refine - (fun x:Option => - match x return x <> Fail -> bool with - | Fail => _ - | Ok b => fun _ => b - end). - - intros; absurd (Fail = Fail); trivial. - + refine + (fun x:Option => + match x return x <> Fail -> bool with + | Fail => _ + | Ok b => fun _ => b + end). + intros; absurd (Fail = Fail); trivial. Defined. .. exn:: Invalid argument. @@ -251,41 +255,43 @@ Applying theorems .. tacv:: notypeclasses refine @term :name: notypeclasses refine - This tactic behaves like :tacn:`refine` except it performs typechecking without + This tactic behaves like :tacn:`refine` except it performs type checking without resolution of typeclasses. .. tacv:: simple notypeclasses refine @term :name: simple notypeclasses refine - This tactic behaves like :tacn:`simple refine` except it performs typechecking + This tactic behaves like :tacn:`simple refine` except it performs type checking without resolution of typeclasses. .. tacn:: apply @term :name: apply - This tactic applies to any goal. The argument term is a term well-formed in the - local context. The tactic apply tries to match the current goal against the - conclusion of the type of term. If it succeeds, then the tactic returns as many - subgoals as the number of non-dependent premises of the type of term. If the - conclusion of the type of term does not match the goal *and* the conclusion is - an inductive type isomorphic to a tuple type, then each component of the tuple - is recursively matched to the goal in the left-to-right order. - - The tactic :tacn:`apply` relies on first-order unification with dependent types - unless the conclusion of the type of :token:`term` is of the form :g:`P (t`:sub:`1` - :g:`...` :g:`t`:sub:`n` :g:`)` with `P` to be instantiated. In the latter case, the behavior - depends on the form of the goal. If the goal is of the form - :g:`(fun x => Q) u`:sub:`1` :g:`...` :g:`u`:sub:`n` and the :g:`t`:sub:`i` and - :g:`u`:sub:`i` unifies, then :g:`P` is taken to be :g:`(fun x => Q)`. Otherwise, - :tacn:`apply` tries to define :g:`P` by abstracting over :g:`t`:sub:`1` :g:`...` - :g:`t`:sub:`n` in the goal. See :tacn:`pattern` to transform the goal so that it - gets the form :g:`(fun x => Q) u`:sub:`1` :g:`...` :g:`u`:sub:`n`. - - .. exn:: Unable to unify ... with ... . - - The apply tactic failed to match the conclusion of :token:`term` and the - current goal. You can help the apply tactic by transforming your goal with - the :tacn:`change` or :tacn:`pattern` tactics. + This tactic applies to any goal. The argument term is a term well-formed in + the local context. The tactic :tacn:`apply` tries to match the current goal + against the conclusion of the type of :token:`term`. If it succeeds, then + the tactic returns as many subgoals as the number of non-dependent premises + of the type of term. If the conclusion of the type of :token:`term` does + not match the goal *and* the conclusion is an inductive type isomorphic to + a tuple type, then each component of the tuple is recursively matched to + the goal in the left-to-right order. + + The tactic :tacn:`apply` relies on first-order unification with dependent + types unless the conclusion of the type of :token:`term` is of the form + :n:`P (t__1 ... t__n)` with ``P`` to be instantiated. In the latter case, + the behavior depends on the form of the goal. If the goal is of the form + :n:`(fun x => Q) u__1 ... u__n` and the :n:`t__i` and :n:`u__i` unify, + then :g:`P` is taken to be :g:`(fun x => Q)`. Otherwise, :tacn:`apply` + tries to define :g:`P` by abstracting over :g:`t_1 ... t__n` in the goal. + See :tacn:`pattern` to transform the goal so that it + gets the form :n:`(fun x => Q) u__1 ... u__n`. + + .. exn:: Unable to unify @term with @term. + + The :tacn:`apply` tactic failed to match the conclusion of :token:`term` + and the current goal. You can help the :tacn:`apply` tactic by + transforming your goal with the :tacn:`change` or :tacn:`pattern` + tactics. .. exn:: Unable to find an instance for the variables {+ @ident}. @@ -301,6 +307,7 @@ Applying theorems according to the order of these dependent premises of the type of term. .. exn:: Not the right number of missing arguments. + :undocumented: .. tacv:: apply @term with @bindings_list @@ -310,11 +317,9 @@ Applying theorems .. tacv:: apply {+, @term} - This is a shortcut for :n:`apply @term`:sub:`1` - :n:`; [.. | ... ; [ .. | apply @term`:sub:`n` :n:`] ... ]`, - i.e. for the successive applications of :token:`term`:sub:`i+1` on the last subgoal - generated by :n:`apply @term`:sub:`i` , starting from the application of - :token:`term`:sub:`1`. + This is a shortcut for :n:`apply @term__1; [.. | ... ; [ .. | apply @term__n] ... ]`, + i.e. for the successive applications of :n:`@term`:sub:`i+1` on the last subgoal + generated by :n:`apply @term__i` , starting from the application of :n:`@term__1`. .. tacv:: eapply @term :name: eapply @@ -326,7 +331,6 @@ Applying theorems intended to be found later in the proof. .. tacv:: simple apply @term. - :name: simple apply This behaves like :tacn:`apply` but it reasons modulo conversion only on subterms that contain no variables to instantiate. For instance, the following example @@ -348,8 +352,8 @@ Applying theorems does. .. tacv:: {? simple} apply {+, @term {? with @bindings_list}} - .. tacv:: {? simple} eapply {+, @term {? with @bindings_list}} - :name: simple eapply + {? simple} eapply {+, @term {? with @bindings_list}} + :name: simple apply; simple eapply This summarizes the different syntaxes for :tacn:`apply` and :tacn:`eapply`. @@ -364,8 +368,10 @@ Applying theorems sequence ``cut B. 2:apply H.`` where ``cut`` is described below. .. warn:: When @term contains more than one non dependent product the tactic lapply only takes into account the first product. + :undocumented: .. example:: + Assume we have a transitive relation ``R`` on ``nat``: .. coqtop:: reset in @@ -453,164 +459,151 @@ Applying theorems .. tacn:: apply @term in @ident :name: apply ... in - This tactic applies to any goal. The argument ``term`` is a term well-formed in - the local context and the argument :n:`@ident` is an hypothesis of the context. - The tactic ``apply term in ident`` tries to match the conclusion of the type - of :n:`@ident` against a non-dependent premise of the type of ``term``, trying - them from right to left. If it succeeds, the statement of hypothesis - :n:`@ident` is replaced by the conclusion of the type of ``term``. The tactic - also returns as many subgoals as the number of other non-dependent premises - in the type of ``term`` and of the non-dependent premises of the type of - :n:`@ident`. If the conclusion of the type of ``term`` does not match the goal - *and* the conclusion is an inductive type isomorphic to a tuple type, then + This tactic applies to any goal. The argument :token:`term` is a term + well-formed in the local context and the argument :token:`ident` is an + hypothesis of the context. + The tactic :n:`apply @term in @ident` tries to match the conclusion of the + type of :token:`ident` against a non-dependent premise of the type + of :token:`term`, trying them from right to left. If it succeeds, the + statement of hypothesis :token:`ident` is replaced by the conclusion of + the type of :token:`term`. The tactic also returns as many subgoals as the + number of other non-dependent premises in the type of :token:`term` and of + the non-dependent premises of the type of :token:`ident`. If the conclusion + of the type of :token:`term` does not match the goal *and* the conclusion + is an inductive type isomorphic to a tuple type, then the tuple is (recursively) decomposed and the first component of the tuple of which a non-dependent premise matches the conclusion of the type of - :n:`@ident`. Tuples are decomposed in a width-first left-to-right order (for - instance if the type of :g:`H1` is :g:`A <-> B` and the type of - :g:`H2` is :g:`A` then ``apply H1 in H2`` transforms the type of :g:`H2` - into :g:`B`). The tactic ``apply`` relies on first-order pattern-matching + :token:`ident`. Tuples are decomposed in a width-first left-to-right order + (for instance if the type of :g:`H1` is :g:`A <-> B` and the type of + :g:`H2` is :g:`A` then :g:`apply H1 in H2` transforms the type of :g:`H2` + into :g:`B`). The tactic :tacn:`apply` relies on first-order pattern-matching with dependent types. -.. exn:: Statement without assumptions. - - This happens if the type of ``term`` has no non dependent premise. - -.. exn:: Unable to apply. + .. exn:: Statement without assumptions. - This happens if the conclusion of :n:`@ident` does not match any of the non - dependent premises of the type of ``term``. + This happens if the type of :token:`term` has no non-dependent premise. -.. tacv:: apply {+, @term} in @ident + .. exn:: Unable to apply. - This applies each of ``term`` in sequence in :n:`@ident`. + This happens if the conclusion of :token:`ident` does not match any of + the non-dependent premises of the type of :token:`term`. -.. tacv:: apply {+, @term with @bindings_list} in @ident + .. tacv:: apply {+, @term} in @ident - This does the same but uses the bindings in each :n:`(@id := @ val)` to - instantiate the parameters of the corresponding type of ``term`` (see - :ref:`bindings list <bindingslist>`). + This applies each :token:`term` in sequence in :token:`ident`. -.. tacv:: eapply {+, @term with @bindings_list} in @ident + .. tacv:: apply {+, @term with @bindings_list} in @ident - This works as :tacn:`apply ... in` but turns unresolved bindings into - existential variables, if any, instead of failing. + This does the same but uses the bindings in each :n:`(@ident := @term)` to + instantiate the parameters of the corresponding type of :token:`term` + (see :ref:`bindings list <bindingslist>`). -.. tacv:: apply {+, @term with @bindings_list} in @ident as @intro_pattern - :name: apply ... in ... as + .. tacv:: eapply {+, @term {? with @bindings_list } } in @ident - This works as :tacn:`apply ... in` then applies the - :n:`@intro_pattern` to the hypothesis :n:`@ident`. + This works as :tacn:`apply ... in` but turns unresolved bindings into + existential variables, if any, instead of failing. -.. tacv:: eapply {+, @term with @bindings_list} in @ident as @intro_pattern. + .. tacv:: apply {+, @term {? with @bindings_list } } in @ident as @intro_pattern + :name: apply ... in ... as - This works as :tacn:`apply ... in ... as` but using ``eapply``. + This works as :tacn:`apply ... in` then applies the :token:`intro_pattern` + to the hypothesis :token:`ident`. -.. tacv:: simple apply @term in @ident + .. tacv:: simple apply @term in @ident - This behaves like :tacn:`apply ... in` but it reasons modulo conversion only - on subterms that contain no variables to instantiate. For instance, if - :g:`id := fun x:nat => x` and :g:`H: forall y, id y = y -> True` and - :g:`H0 : O = O` then ``simple apply H in H0`` does not succeed because it - would require the conversion of :g:`id ?x` and :g:`O` where :g:`?x` is - an existential variable to instantiate. Tactic :n:`simple apply @term in @ident` does not - either traverse tuples as :n:`apply @term in @ident` does. + This behaves like :tacn:`apply ... in` but it reasons modulo conversion + only on subterms that contain no variables to instantiate. For instance, + if :g:`id := fun x:nat => x` and :g:`H: forall y, id y = y -> True` and + :g:`H0 : O = O` then :g:`simple apply H in H0` does not succeed because it + would require the conversion of :g:`id ?x` and :g:`O` where :g:`?x` is + an existential variable to instantiate. + Tactic :n:`simple apply @term in @ident` does not + either traverse tuples as :n:`apply @term in @ident` does. -.. tacv:: {? simple} apply {+, @term {? with @bindings_list}} in @ident {? as @intro_pattern} -.. tacv:: {? simple} eapply {+, @term {? with @bindings_list}} in @ident {? as @intro_pattern} + .. tacv:: {? simple} apply {+, @term {? with @bindings_list}} in @ident {? as @intro_pattern} + {? simple} eapply {+, @term {? with @bindings_list}} in @ident {? as @intro_pattern} - This summarizes the different syntactic variants of :n:`apply @term in @ident` - and :n:`eapply @term in @ident`. + This summarizes the different syntactic variants of :n:`apply @term in @ident` + and :n:`eapply @term in @ident`. .. tacn:: constructor @num :name: constructor This tactic applies to a goal such that its conclusion is an inductive - type (say :g:`I`). The argument :n:`@num` must be less or equal to the - numbers of constructor(s) of :g:`I`. Let :g:`c`:sub:`i` be the i-th - constructor of :g:`I`, then ``constructor i`` is equivalent to - ``intros; apply c``:sub:`i`. + type (say :g:`I`). The argument :token:`num` must be less or equal to the + numbers of constructor(s) of :g:`I`. Let :n:`c__i` be the i-th + constructor of :g:`I`, then :g:`constructor i` is equivalent to + :n:`intros; apply c__i`. -.. exn:: Not an inductive product. -.. exn:: Not enough constructors. - -.. tacv:: constructor - - This tries :g:`constructor`:sub:`1` then :g:`constructor`:sub:`2`, ..., then - :g:`constructor`:sub:`n` where `n` is the number of constructors of the head - of the goal. - -.. tacv:: constructor @num with @bindings_list - - Let ``c`` be the i-th constructor of :g:`I`, then - :n:`constructor i with @bindings_list` is equivalent to - :n:`intros; apply c with @bindings_list`. + .. exn:: Not an inductive product. + :undocumented: - .. warn:: - The terms in the @bindings_list are checked in the context where constructor is executed and not in the context where @apply is executed (the introductions are not taken into account). + .. exn:: Not enough constructors. + :undocumented: -.. tacv:: split - :name: split + .. tacv:: constructor - This applies only if :g:`I` has a single constructor. It is then - equivalent to :n:`constructor 1.`. It is typically used in the case of a - conjunction :g:`A` :math:`\wedge` :g:`B`. + This tries :g:`constructor 1` then :g:`constructor 2`, ..., then + :g:`constructor n` where ``n`` is the number of constructors of the head + of the goal. -.. exn:: Not an inductive goal with 1 constructor + .. tacv:: constructor @num with @bindings_list -.. tacv:: exists @val - :name: exists + Let ``c`` be the i-th constructor of :g:`I`, then + :n:`constructor i with @bindings_list` is equivalent to + :n:`intros; apply c with @bindings_list`. - This applies only if :g:`I` has a single constructor. It is then equivalent - to :n:`intros; constructor 1 with @bindings_list.` It is typically used in - the case of an existential quantification :math:`\exists`:g:`x, P(x).` - -.. exn:: Not an inductive goal with 1 constructor. - -.. tacv:: exists @bindings_list + .. warning:: - This iteratively applies :n:`exists @bindings_list`. + The terms in the :token:`bindings_list` are checked in the context + where constructor is executed and not in the context where :tacn:`apply` + is executed (the introductions are not taken into account). -.. tacv:: left - :name: left + .. tacv:: split {? with @bindings_list } + :name: split -.. tacv:: right - :name: right + This applies only if :g:`I` has a single constructor. It is then + equivalent to :n:`constructor 1 {? with @bindings_list }`. It is + typically used in the case of a conjunction :math:`A \wedge B`. - These tactics apply only if :g:`I` has two constructors, for - instance in the case of a disjunction :g:`A` :math:`\vee` :g:`B`. - Then, they are respectively equivalent to ``constructor 1`` and - ``constructor 2``. + .. tacv:: exists @bindings_list + :name: exists -.. exn:: Not an inductive goal with 2 constructors. + This applies only if :g:`I` has a single constructor. It is then equivalent + to :n:`intros; constructor 1 with @bindings_list.` It is typically used in + the case of an existential quantification :math:`\exists x, P(x).` -.. tacv:: left with @bindings_list -.. tacv:: right with @bindings_list -.. tacv:: split with @bindings_list + .. tacv:: exists {+, @bindings_list } - As soon as the inductive type has the right number of constructors, these - expressions are equivalent to calling :n:`constructor i with @bindings_list` - for the appropriate ``i``. + This iteratively applies :n:`exists @bindings_list`. -.. tacv:: econstructor - :name: econstructor + .. exn:: Not an inductive goal with 1 constructor. + :undocumented: -.. tacv:: eexists - :name: eexists + .. tacv:: left {? with @bindings_list } + right {? with @bindings_list } + :name: left; right -.. tacv:: esplit - :name: esplit + These tactics apply only if :g:`I` has two constructors, for + instance in the case of a disjunction :math:`A \vee B`. + Then, they are respectively equivalent to + :n:`constructor 1 {? with @bindings_list }` and + :n:`constructor 2 {? with @bindings_list }`. -.. tacv:: eleft - :name: eleft + .. exn:: Not an inductive goal with 2 constructors. -.. tacv:: eright - :name: eright + .. tacv:: econstructor + eexists + esplit + eleft + eright + :name: econstructor; eexists; esplit; eleft; eright - These tactics and their variants behave like :tacn:`constructor`, - :tacn:`exists`, :tacn:`split`, :tacn:`left`, :tacn:`right` and their variants - but they introduce existential variables instead of failing when the - instantiation of a variable cannot be found (cf. :tacn:`eapply` and - :tacn:`apply`). + These tactics and their variants behave like :tacn:`constructor`, + :tacn:`exists`, :tacn:`split`, :tacn:`left`, :tacn:`right` and their + variants but they introduce existential variables instead of failing + when the instantiation of a variable cannot be found + (cf. :tacn:`eapply` and :tacn:`apply`). .. _managingthelocalcontext: @@ -621,101 +614,107 @@ Managing the local context .. tacn:: intro :name: intro -This tactic applies to a goal that is either a product or starts with a let -binder. If the goal is a product, the tactic implements the "Lam" rule given in -:ref:`Typing-rules` [1]_. If the goal starts with a let binder, then the -tactic implements a mix of the "Let" and "Conv". + This tactic applies to a goal that is either a product or starts with a + let-binder. If the goal is a product, the tactic implements the "Lam" rule + given in :ref:`Typing-rules` [1]_. If the goal starts with a let-binder, + then the tactic implements a mix of the "Let" and "Conv". -If the current goal is a dependent product :g:`forall x:T, U` (resp -:g:`let x:=t in U`) then ``intro`` puts :g:`x:T` (resp :g:`x:=t`) in the local -context. The new subgoal is :g:`U`. + If the current goal is a dependent product :g:`forall x:T, U` + (resp :g:`let x:=t in U`) then :tacn:`intro` puts :g:`x:T` (resp :g:`x:=t`) + in the local context. The new subgoal is :g:`U`. -If the goal is a non-dependent product :g:`T`:math:`\rightarrow`:g:`U`, then it -puts in the local context either :g:`Hn:T` (if :g:`T` is of type :g:`Set` or -:g:`Prop`) or :g:`Xn:T` (if the type of :g:`T` is :g:`Type`). The optional index -``n`` is such that ``Hn`` or ``Xn`` is a fresh identifier. In both cases, the -new subgoal is :g:`U`. + If the goal is a non-dependent product :math:`T \rightarrow U`, then it + puts in the local context either :g:`Hn:T` (if :g:`T` is of type :g:`Set` + or :g:`Prop`) or :g:`Xn:T` (if the type of :g:`T` is :g:`Type`). + The optional index ``n`` is such that ``Hn`` or ``Xn`` is a fresh + identifier. In both cases, the new subgoal is :g:`U`. -If the goal is an existential variable, ``intro`` forces the resolution of the -existential variable into a dependent product :math:`forall`:g:`x:?X, ?Y`, puts -:g:`x:?X` in the local context and leaves :g:`?Y` as a new subgoal allowed to -depend on :g:`x`. + If the goal is an existential variable, :tacn:`intro` forces the resolution + of the existential variable into a dependent product :math:`\forall`\ :g:`x:?X, ?Y`, + puts :g:`x:?X` in the local context and leaves :g:`?Y` as a new subgoal + allowed to depend on :g:`x`. -the tactic ``intro`` applies the tactic ``hnf`` until the tactic ``intro`` can -be applied or the goal is not head-reducible. + The tactic :tacn:`intro` applies the tactic :tacn:`hnf` + until :tacn:`intro` can be applied or the goal is not head-reducible. -.. exn:: No product even after head-reduction. -.. exn:: @ident is already used. + .. exn:: No product even after head-reduction. + :undocumented: -.. tacv:: intros - :name: intros + .. tacv:: intro @ident - This repeats ``intro`` until it meets the head-constant. It never - reduces head-constants and it never fails. + This applies :tacn:`intro` but forces :token:`ident` to be the name of + the introduced hypothesis. -.. tacn:: intro @ident + .. exn:: @ident is already used. + :undocumented: - This applies ``intro`` but forces :n:`@ident` to be the name of the - introduced hypothesis. + .. note:: -.. exn:: Name @ident is already used. + If a name used by intro hides the base name of a global constant then + the latter can still be referred to by a qualified name + (see :ref:`Qualified-names`). -.. note:: If a name used by intro hides the base name of a global - constant then the latter can still be referred to by a qualified name - (see :ref:`Qualified-names`). -.. tacv:: intros {+ @ident}. + .. tacv:: intros + :name: intros - This is equivalent to the composed tactic - :n:`intro @ident; ... ; intro @ident`. More generally, the ``intros`` tactic - takes a pattern as argument in order to introduce names for components - of an inductive definition or to clear introduced hypotheses. This is - explained in :ref:`Managingthelocalcontext`. + This repeats :tacn:`intro` until it meets the head-constant. It never + reduces head-constants and it never fails. -.. tacv:: intros until @ident + .. tacv:: intros {+ @ident}. - This repeats intro until it meets a premise of the goal having form - `(@ident:term)` and discharges the variable named `ident` of the current - goal. + This is equivalent to the composed tactic :n:`intro @ident; ... ; intro @ident`. -.. exn:: No such hypothesis in current goal. + .. tacv:: intros until @ident -.. tacv:: intros until @num + This repeats intro until it meets a premise of the goal having the + form :n:`(@ident : @type)` and discharges the variable + named :token:`ident` of the current goal. - This repeats intro until the `num`-th non-dependent product. For instance, - on the subgoal :g:`forall x y:nat, x=y -> y=x` the tactic - :n:`intros until 1` is equivalent to :n:`intros x y H`, as :g:`x=y -> y=x` - is the first non-dependent product. And on the subgoal :g:`forall x y - z:nat, x=y -> y=x` the tactic :n:`intros until 1` is equivalent to - :n:`intros x y z` as the product on :g:`z` can be rewritten as a - non-dependent product: :g:`forall x y:nat, nat -> x=y -> y=x` + .. exn:: No such hypothesis in current goal. + :undocumented: -.. exn:: No such hypothesis in current goal. + .. tacv:: intros until @num - This happens when `num` is 0 or is greater than the number of non-dependent - products of the goal. + This repeats :tacn:`intro` until the :token:`num`\-th non-dependent + product. -.. tacv:: intro after @ident -.. tacv:: intro before @ident -.. tacv:: intro at top -.. tacv:: intro at bottom + .. example:: - These tactics apply :n:`intro` and move the freshly introduced hypothesis - respectively after the hypothesis :n:`@ident`, before the hypothesis - :n:`@ident`, at the top of the local context, or at the bottom of the local - context. All hypotheses on which the new hypothesis depends are moved - too so as to respect the order of dependencies between hypotheses. - Note that :n:`intro at bottom` is a synonym for :n:`intro` with no argument. + On the subgoal :g:`forall x y : nat, x = y -> y = x` the + tactic :n:`intros until 1` is equivalent to :n:`intros x y H`, + as :g:`x = y -> y = x` is the first non-dependent product. -.. exn:: No such hypothesis: @ident. + On the subgoal :g:`forall x y z : nat, x = y -> y = x` the + tactic :n:`intros until 1` is equivalent to :n:`intros x y z` + as the product on :g:`z` can be rewritten as a non-dependent + product: :g:`forall x y : nat, nat -> x = y -> y = x`. + + .. exn:: No such hypothesis in current goal. + + This happens when :token:`num` is 0 or is greater than the number of + non-dependent products of the goal. + + .. tacv:: intro {? @ident__1 } after @ident__2 + intro {? @ident__1 } before @ident__2 + intro {? @ident__1 } at top + intro {? @ident__1 } at bottom -.. tacv:: intro @ident after @ident -.. tacv:: intro @ident before @ident -.. tacv:: intro @ident at top -.. tacv:: intro @ident at bottom + These tactics apply :n:`intro {? @ident__1}` and move the freshly + introduced hypothesis respectively after the hypothesis :n:`@ident__2`, + before the hypothesis :n:`@ident__2`, at the top of the local context, + or at the bottom of the local context. All hypotheses on which the new + hypothesis depends are moved too so as to respect the order of + dependencies between hypotheses. It is equivalent to :n:`intro {? @ident__1 }` + followed by the appropriate call to :tacn:`move ... after ...`, + :tacn:`move ... before ...`, :tacn:`move ... at top`, + or :tacn:`move ... at bottom`. - These tactics behave as previously but naming the introduced hypothesis - :n:`@ident`. It is equivalent to :n:`intro @ident` followed by the - appropriate call to ``move`` (see :tacn:`move ... after ...`). + .. note:: + + :n:`intro at bottom` is a synonym for :n:`intro` with no argument. + + .. exn:: No such hypothesis: @ident. + :undocumented: .. tacn:: intros @intro_pattern_list :name: intros ... @@ -764,24 +763,22 @@ be applied or the goal is not head-reducible. :n:`intros p` is defined inductively over the structure of the introduction pattern :n:`p`: -Introduction on :n:`?` performs the introduction, and lets Coq choose a fresh -name for the variable; - -Introduction on :n:`?ident` performs the introduction, and lets Coq choose a -fresh name for the variable based on :n:`@ident`; + Introduction on :n:`?` performs the introduction, and lets Coq choose a fresh + name for the variable; -Introduction on :n:`@ident` behaves as described in :tacn:`intro` + Introduction on :n:`?@ident` performs the introduction, and lets Coq choose a + fresh name for the variable based on :n:`@ident`; -Introduction over a disjunction of list of patterns -:n:`[@intro_pattern_list | ... | @intro_pattern_list ]` expects the product -to be over an inductive type whose number of constructors is `n` (or more -generally over a type of conclusion an inductive type built from `n` -constructors, e.g. :g:`C -> A\/B` with `n=2` since :g:`A\/B` has `2` -constructors): it destructs the introduced hypothesis as :n:`destruct` (see -:tacn:`destruct`) would and applies on each generated subgoal the -corresponding tactic; + Introduction on :n:`@ident` behaves as described in :tacn:`intro` -.. tacv:: intros @intro_pattern_list + Introduction over a disjunction of list of patterns + :n:`[@intro_pattern_list | ... | @intro_pattern_list ]` expects the product + to be over an inductive type whose number of constructors is `n` (or more + generally over a type of conclusion an inductive type built from `n` + constructors, e.g. :g:`C -> A\/B` with `n=2` since :g:`A\/B` has `2` + constructors): it destructs the introduced hypothesis as :n:`destruct` (see + :tacn:`destruct`) would and applies on each generated subgoal the + corresponding tactic; The introduction patterns in :n:`@intro_pattern_list` are expected to consume no more than the number of arguments of the `i`-th constructor. If it @@ -790,59 +787,59 @@ corresponding tactic; list of patterns :n:`[ | ] H` applied on goal :g:`forall x:nat, x=0 -> 0=x` behaves the same as the list of patterns :n:`[ | ? ] H`); -Introduction over a conjunction of patterns :n:`({+, p})` expects -the goal to be a product over an inductive type :g:`I` with a single -constructor that itself has at least `n` arguments: It performs a case -analysis over the hypothesis, as :n:`destruct` would, and applies the -patterns :n:`{+ p}` to the arguments of the constructor of :g:`I` (observe -that :n:`({+ p})` is an alternative notation for :n:`[{+ p}]`); - -Introduction via :n:`({+& p})` is a shortcut for introduction via -:n:`(p,( ... ,( ..., p ) ... ))`; it expects the hypothesis to be a sequence of -right-associative binary inductive constructors such as :g:`conj` or -:g:`ex_intro`; for instance, an hypothesis with type -:g:`A /\(exists x, B /\ C /\ D)` can be introduced via pattern -:n:`(a & x & b & c & d)`; - -If the product is over an equality type, then a pattern of the form -:n:`[= {+ p}]` applies either :tacn:`injection` or :tacn:`discriminate` -instead of :tacn:`destruct`; if :tacn:`injection` is applicable, the patterns -:n:`{+, p}` are used on the hypotheses generated by :tacn:`injection`; if the -number of patterns is smaller than the number of hypotheses generated, the -pattern :n:`?` is used to complete the list; - -.. tacv:: introduction over -> -.. tacv:: introduction over <- - + Introduction over a conjunction of patterns :n:`({+, p})` expects + the goal to be a product over an inductive type :g:`I` with a single + constructor that itself has at least `n` arguments: It performs a case + analysis over the hypothesis, as :n:`destruct` would, and applies the + patterns :n:`{+ p}` to the arguments of the constructor of :g:`I` (observe + that :n:`({+ p})` is an alternative notation for :n:`[{+ p}]`); + + Introduction via :n:`({+& p})` is a shortcut for introduction via + :n:`(p,( ... ,( ..., p ) ... ))`; it expects the hypothesis to be a sequence of + right-associative binary inductive constructors such as :g:`conj` or + :g:`ex_intro`; for instance, a hypothesis with type + :g:`A /\(exists x, B /\ C /\ D)` can be introduced via pattern + :n:`(a & x & b & c & d)`; + + If the product is over an equality type, then a pattern of the form + :n:`[= {+ p}]` applies either :tacn:`injection` or :tacn:`discriminate` + instead of :tacn:`destruct`; if :tacn:`injection` is applicable, the patterns + :n:`{+, p}` are used on the hypotheses generated by :tacn:`injection`; if the + number of patterns is smaller than the number of hypotheses generated, the + pattern :n:`?` is used to complete the list. + + Introduction over ``->`` (respectively over ``<-``) expects the hypothesis to be an equality and the right-hand-side (respectively the left-hand-side) is replaced by the left-hand-side (respectively the right-hand-side) in the conclusion of the goal; the hypothesis itself is erased; if the term to substitute is a variable, it - is substituted also in the context of goal and the variable is removed too; + is substituted also in the context of goal and the variable is removed too. -Introduction over a pattern :n:`p{+ %term}` first applies :n:`{+ term}` -on the hypothesis to be introduced (as in :n:`apply {+, term}`) prior to the -application of the introduction pattern :n:`p`; + Introduction over a pattern :n:`p{+ %term}` first applies :n:`{+ term}` + on the hypothesis to be introduced (as in :n:`apply {+, term}`) prior to the + application of the introduction pattern :n:`p`; -Introduction on the wildcard depends on whether the product is dependent or not: -in the non-dependent case, it erases the corresponding hypothesis (i.e. it -behaves as an :tacn:`intro` followed by a :tacn:`clear`) while in the -dependent case, it succeeds and erases the variable only if the wildcard is part -of a more complex list of introduction patterns that also erases the hypotheses -depending on this variable; + Introduction on the wildcard depends on whether the product is dependent or not: + in the non-dependent case, it erases the corresponding hypothesis (i.e. it + behaves as an :tacn:`intro` followed by a :tacn:`clear`) while in the + dependent case, it succeeds and erases the variable only if the wildcard is part + of a more complex list of introduction patterns that also erases the hypotheses + depending on this variable; -Introduction over :n:`*` introduces all forthcoming quantified variables -appearing in a row; introduction over :n:`**` introduces all forthcoming -quantified variables or hypotheses until the goal is not any more a -quantification or an implication. + Introduction over :n:`*` introduces all forthcoming quantified variables + appearing in a row; introduction over :n:`**` introduces all forthcoming + quantified variables or hypotheses until the goal is not any more a + quantification or an implication. -.. example:: - .. coqtop:: all + .. example:: - Goal forall A B C:Prop, A \/ B /\ C -> (A -> C) -> C. - intros * [a | (_,c)] f. + .. coqtop:: reset all + + Goal forall A B C:Prop, A \/ B /\ C -> (A -> C) -> C. + intros * [a | (_,c)] f. .. note:: + :n:`intros {+ p}` is not equivalent to :n:`intros p; ... ; intros p` for the following reason: If one of the :n:`p` is a wildcard pattern, it might succeed in the first case because the further hypotheses it @@ -851,6 +848,7 @@ quantification or an implication. introduced (and a fortiori not yet erased). .. note:: + In :n:`intros @intro_pattern_list`, if the last introduction pattern is a disjunctive or conjunctive pattern :n:`[{+| @intro_pattern_list}]`, the completion of :n:`@intro_pattern_list` @@ -869,38 +867,42 @@ quantification or an implication. the current goal. As a consequence, :n:`@ident` is no more displayed and no more usable in the proof development. -.. exn:: No such hypothesis. + .. exn:: No such hypothesis. + :undocumented: -.. exn:: @ident is used in the conclusion. + .. exn:: @ident is used in the conclusion. + :undocumented: -.. exn:: @ident is used in the hypothesis @ident. + .. exn:: @ident is used in the hypothesis @ident. + :undocumented: -.. tacv:: clear {+ @ident} + .. tacv:: clear {+ @ident} - This is equivalent to :n:`clear @ident. ... clear @ident.` + This is equivalent to :n:`clear @ident. ... clear @ident.` -.. tacv:: clear - {+ @ident} + .. tacv:: clear - {+ @ident} - This tactic clears all the hypotheses except the ones depending in the - hypotheses named :n:`{+ @ident}` and in the goal. + This variant clears all the hypotheses except the ones depending in the + hypotheses named :n:`{+ @ident}` and in the goal. -.. tacv:: clear + .. tacv:: clear - This tactic clears all the hypotheses except the ones the goal depends on. + This variants clears all the hypotheses except the ones the goal depends on. -.. tacv:: clear dependent @ident + .. tacv:: clear dependent @ident - This clears the hypothesis :n:`@ident` and all the hypotheses that depend on - it. + This clears the hypothesis :token:`ident` and all the hypotheses that + depend on it. -.. tacv:: clearbody {+ @ident} - :name: clearbody + .. tacv:: clearbody {+ @ident} + :name: clearbody - This tactic expects :n:`{+ @ident}` to be local definitions and clears their - respective bodies. - In other words, it turns the given definitions into assumptions. + This tactic expects :n:`{+ @ident}` to be local definitions and clears + their respective bodies. + In other words, it turns the given definitions into assumptions. -.. exn:: @ident is not a local definition. + .. exn:: @ident is not a local definition. + :undocumented: .. tacn:: revert {+ @ident} :name: revert @@ -909,171 +911,184 @@ quantification or an implication. (possibly defined) to the goal, if this respects dependencies. This tactic is the inverse of :tacn:`intro`. -.. exn:: No such hypothesis. + .. exn:: No such hypothesis. + :undocumented: -.. exn:: @ident is used in the hypothesis @ident. + .. exn:: @ident__1 is used in the hypothesis @ident__2. + :undocumented: -.. tacn:: revert dependent @ident + .. tacv:: revert dependent @ident + :name: revert dependent - This moves to the goal the hypothesis :n:`@ident` and all the hypotheses that - depend on it. + This moves to the goal the hypothesis :token:`ident` and all the + hypotheses that depend on it. -.. tacn:: move @ident after @ident +.. tacn:: move @ident__1 after @ident__2 :name: move ... after ... - This moves the hypothesis named :n:`@ident` in the local context after the - hypothesis named :n:`@ident`, where “after” is in reference to the + This moves the hypothesis named :n:`@ident__1` in the local context after + the hypothesis named :n:`@ident__2`, where “after” is in reference to the direction of the move. The proof term is not changed. - If :n:`@ident` comes before :n:`@ident` in the order of dependencies, then - all the hypotheses between :n:`@ident` and :n:`ident@` that (possibly - indirectly) depend on :n:`@ident` are moved too, and all of them are thus - moved after :n:`@ident` in the order of dependencies. + If :n:`@ident__1` comes before :n:`@ident__2` in the order of dependencies, + then all the hypotheses between :n:`@ident__1` and :n:`@ident__2` that + (possibly indirectly) depend on :n:`@ident__1` are moved too, and all of + them are thus moved after :n:`@ident__2` in the order of dependencies. - If :n:`@ident` comes after :n:`@ident` in the order of dependencies, then all - the hypotheses between :n:`@ident` and :n:`@ident` that (possibly indirectly) - occur in the type of :n:`@ident` are moved too, and all of them are thus - moved before :n:`@ident` in the order of dependencies. + If :n:`@ident__1` comes after :n:`@ident__2` in the order of dependencies, + then all the hypotheses between :n:`@ident__1` and :n:`@ident__2` that + (possibly indirectly) occur in the type of :n:`@ident__1` are moved too, + and all of them are thus moved before :n:`@ident__2` in the order of + dependencies. -.. tacv:: move @ident before @ident + .. tacv:: move @ident__1 before @ident__2 + :name: move ... before ... - This moves :n:`@ident` towards and just before the hypothesis named - :n:`@ident`. As for :tacn:`move ... after ...`, dependencies over - :n:`@ident` (when :n:`@ident` comes before :n:`@ident` in the order of - dependencies) or in the type of :n:`@ident` (when :n:`@ident` comes after - :n:`@ident` in the order of dependencies) are moved too. + This moves :n:`@ident__1` towards and just before the hypothesis + named :n:`@ident__2`. As for :tacn:`move ... after ...`, dependencies + over :n:`@ident__1` (when :n:`@ident__1` comes before :n:`@ident__2` in + the order of dependencies) or in the type of :n:`@ident__1` + (when :n:`@ident__1` comes after :n:`@ident__2` in the order of + dependencies) are moved too. -.. tacv:: move @ident at top + .. tacv:: move @ident at top + :name: move ... at top - This moves :n:`@ident` at the top of the local context (at the beginning of - the context). + This moves :token:`ident` at the top of the local context (at the beginning + of the context). -.. tacv:: move @ident at bottom + .. tacv:: move @ident at bottom + :name: move ... at bottom - This moves ident at the bottom of the local context (at the end of the - context). + This moves :token:`ident` at the bottom of the local context (at the end of + the context). -.. exn:: No such hypothesis. -.. exn:: Cannot move @ident after @ident : it occurs in the type of @ident. -.. exn:: Cannot move @ident after @ident : it depends on @ident. + .. exn:: No such hypothesis. + :undocumented: -.. example:: - .. coqtop:: all + .. exn:: Cannot move @ident__1 after @ident__2: it occurs in the type of @ident__2. + :undocumented: + + .. exn:: Cannot move @ident__1 after @ident__2: it depends on @ident__2. + :undocumented: + + .. example:: + + .. coqtop:: reset all - Goal forall x :nat, x = 0 -> forall z y:nat, y=y-> 0=x. - intros x H z y H0. - move x after H0. - Undo. - move x before H0. - Undo. - move H0 after H. - Undo. - move H0 before H. - -.. tacn:: rename @ident into @ident + Goal forall x :nat, x = 0 -> forall z y:nat, y=y-> 0=x. + intros x H z y H0. + move x after H0. + Undo. + move x before H0. + Undo. + move H0 after H. + Undo. + move H0 before H. + +.. tacn:: rename @ident__1 into @ident__2 :name: rename -This renames hypothesis :n:`@ident` into :n:`@ident` in the current context. -The name of the hypothesis in the proof-term, however, is left unchanged. + This renames hypothesis :n:`@ident__1` into :n:`@ident__2` in the current + context. The name of the hypothesis in the proof-term, however, is left + unchanged. -.. tacv:: rename {+, @ident into @ident} + .. tacv:: rename {+, @ident__i into @ident__j} - This renames the variables :n:`@ident` into :n:`@ident` in parallel. In - particular, the target identifiers may contain identifiers that exist in the - source context, as long as the latter are also renamed by the same tactic. + This renames the variables :n:`@ident__i` into :n:`@ident__j` in parallel. + In particular, the target identifiers may contain identifiers that exist in + the source context, as long as the latter are also renamed by the same + tactic. -.. exn:: No such hypothesis. -.. exn:: @ident is already used. + .. exn:: No such hypothesis. + :undocumented: + + .. exn:: @ident is already used. + :undocumented: .. tacn:: set (@ident := @term) :name: set - This replaces :n:`@term` by :n:`@ident` in the conclusion of the current goal - and adds the new definition :g:`ident := term` to the local context. - - If :n:`@term` has holes (i.e. subexpressions of the form “`_`”), the tactic - first checks that all subterms matching the pattern are compatible before - doing the replacement using the leftmost subterm matching the pattern. + This replaces :token:`term` by :token:`ident` in the conclusion of the + current goal and adds the new definition :n:`@ident := @term` to the + local context. -.. exn:: The variable @ident is already defined. + If :token:`term` has holes (i.e. subexpressions of the form “`_`”), the + tactic first checks that all subterms matching the pattern are compatible + before doing the replacement using the leftmost subterm matching the + pattern. -.. tacv:: set (@ident := @term ) in @goal_occurrences + .. exn:: The variable @ident is already defined. + :undocumented: - This notation allows specifying which occurrences of :n:`@term` have to be - substituted in the context. The :n:`in @goal_occurrences` clause is an - occurrence clause whose syntax and behavior are described in - :ref:`goal occurences <occurencessets>`. + .. tacv:: set (@ident := @term) in @goal_occurrences -.. tacv:: set (@ident {+ @binder} := @term ) + This notation allows specifying which occurrences of :token:`term` have + to be substituted in the context. The :n:`in @goal_occurrences` clause + is an occurrence clause whose syntax and behavior are described in + :ref:`goal occurences <occurencessets>`. - This is equivalent to :n:`set (@ident := funbinder {+ binder} => @term )`. + .. tacv:: set (@ident @binders := @term) {? in @goal_occurrences } -.. tacv:: set term - This behaves as :n:`set(@ident := @term)` but :n:`@ident` is generated by - Coq. This variant also supports an occurrence clause. + This is equivalent to :n:`set (@ident := fun @binders => @term) {? in @goal_occurrences }`. -.. tacv:: set (@ident {+ @binder} := @term) in @goal_occurrences -.. tacv:: set @term in @goal_occurrences + .. tacv:: set @term {? in @goal_occurrences } - These are the general forms that combine the previous possibilities. + This behaves as :n:`set (@ident := @term) {? in @goal_occurrences }` + but :token:`ident` is generated by Coq. -.. tacv:: eset (@ident {+ @binder} := @term ) in @goal_occurrences -.. tacv:: eset @term in @goal_occurrences - :name: eset + .. tacv:: eset (@ident {? @binders } := @term) {? in @goal_occurrences } + eset @term {? in @goal_occurrences } + :name: eset; _ - While the different variants of :tacn:`set` expect that no existential - variables are generated by the tactic, :n:`eset` removes this constraint. In - practice, this is relevant only when :n:`eset` is used as a synonym of - :tacn:`epose`, i.e. when the :`@term` does not occur in the goal. + While the different variants of :tacn:`set` expect that no existential + variables are generated by the tactic, :tacn:`eset` removes this + constraint. In practice, this is relevant only when :tacn:`eset` is + used as a synonym of :tacn:`epose`, i.e. when the :token:`term` does + not occur in the goal. -.. tacv:: remember @term as @ident +.. tacn:: remember @term as @ident__1 {? eqn:@ident__2 } :name: remember - This behaves as :n:`set (@ident:= @term ) in *` and using a logical + This behaves as :n:`set (@ident__1 := @term) in *`, using a logical (Leibniz’s) equality instead of a local definition. + If :n:`@ident__2` is provided, it will be the name of the new equation. -.. tacv:: remember @term as @ident eqn:@ident - - This behaves as :n:`remember @term as @ident`, except that the name of the - generated equality is also given. - -.. tacv:: remember @term as @ident in @goal_occurrences + .. tacv:: remember @term as @ident__1 {? eqn:@ident__2 } in @goal_occurrences - This is a more general form of :n:`remember` that remembers the occurrences - of term specified by an occurrence set. + This is a more general form of :tacn:`remember` that remembers the + occurrences of :token:`term` specified by an occurrence set. -.. tacv:: eremember @term as @ident -.. tacv:: eremember @term as @ident in @goal_occurrences -.. tacv:: eremember @term as @ident eqn:@ident - :name: eremember + .. tacv:: eremember @term as @ident__1 {? eqn:@ident__2 } {? in @goal_occurrences } + :name: eremember - While the different variants of :n:`remember` expect that no existential - variables are generated by the tactic, :n:`eremember` removes this constraint. + While the different variants of :tacn:`remember` expect that no + existential variables are generated by the tactic, :tacn:`eremember` + removes this constraint. -.. tacv:: pose ( @ident := @term ) +.. tacn:: pose (@ident := @term) :name: pose This adds the local definition :n:`@ident := @term` to the current context without performing any replacement in the goal or in the hypotheses. It is - equivalent to :n:`set ( @ident := @term ) in |-`. + equivalent to :n:`set (@ident := @term) in |-`. -.. tacv:: pose ( @ident {+ @binder} := @term ) + .. tacv:: pose (@ident @binders := @term) - This is equivalent to :n:`pose (@ident := funbinder {+ binder} => @term)`. + This is equivalent to :n:`pose (@ident := fun @binders => @term)`. -.. tacv:: pose @term + .. tacv:: pose @term - This behaves as :n:`pose (@ident := @term )` but :n:`@ident` is generated by - Coq. + This behaves as :n:`pose (@ident := @term)` but :token:`ident` is + generated by Coq. -.. tacv:: epose (@ident := @term ) -.. tacv:: epose (@ident {+ @binder} := @term ) -.. tacv:: epose term - :name: epose + .. tacv:: epose (@ident {? @binders} := @term) + .. tacv:: epose term + :name: epose - While the different variants of :tacn:`pose` expect that no - existential variables are generated by the tactic, epose removes this - constraint. + While the different variants of :tacn:`pose` expect that no + existential variables are generated by the tactic, :tacn:`epose` + removes this constraint. .. tacn:: decompose [{+ @qualid}] @term :name: decompose @@ -1081,24 +1096,30 @@ The name of the hypothesis in the proof-term, however, is left unchanged. This tactic recursively decomposes a complex proposition in order to obtain atomic ones. -.. example:: - .. coqtop:: all + .. example:: - Goal forall A B C:Prop, A /\ B /\ C \/ B /\ C \/ C /\ A -> C. - intros A B C H; decompose [and or] H; assumption. - Qed. + .. coqtop:: reset all + + Goal forall A B C:Prop, A /\ B /\ C \/ B /\ C \/ C /\ A -> C. + intros A B C H; decompose [and or] H. + all: assumption. + Qed. -:n:`decompose` does not work on right-hand sides of implications or products. + .. note:: + + :tacn:`decompose` does not work on right-hand sides of implications or + products. + + .. tacv:: decompose sum @term -.. tacv:: decompose sum @term + This decomposes sum types (like :g:`or`). - This decomposes sum types (like or). + .. tacv:: decompose record @term -.. tacv:: decompose record @term + This decomposes record types (inductive types with one constructor, + like :g:`and` and :g:`exists` and those defined with the :cmd:`Record` + command. - This decomposes record types (inductive types with one constructor, like - "and" and "exists" and those defined with the Record macro, see - :ref:`record-types`). .. _controllingtheproofflow: @@ -1252,6 +1273,7 @@ Controlling the proof flow respect to some term. .. example:: + .. coqtop:: reset none Goal forall x y:nat, 0 <= x + y + y. @@ -1362,7 +1384,7 @@ goals cannot be closed with :g:`Qed` but only with :g:`Admitted`. :name: contradiction This tactic applies to any goal. The contradiction tactic attempts to - find in the current context (after all intros) an hypothesis that is + find in the current context (after all intros) a hypothesis that is equivalent to an empty inductive type (e.g. :g:`False`), to the negation of a singleton inductive type (e.g. :g:`True` or :g:`x=x`), or two contradictory hypotheses. @@ -1404,94 +1426,101 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) .. tacn:: destruct @term :name: destruct - This tactic applies to any goal. The argument :n:`@term` must be of + This tactic applies to any goal. The argument :token:`term` must be of inductive or co-inductive type and the tactic generates subgoals, one - for each possible form of :n:`@term`, i.e. one for each constructor of the - inductive or co-inductive type. Unlike :n:`induction`, no induction - hypothesis is generated by :n:`destruct`. + for each possible form of :token:`term`, i.e. one for each constructor of the + inductive or co-inductive type. Unlike :tacn:`induction`, no induction + hypothesis is generated by :tacn:`destruct`. - There are special cases: + .. tacv:: destruct @ident - + If :n:`@term` is an identifier :n:`@ident` denoting a quantified variable - of the conclusion of the goal, then :n:`destruct @ident` behaves as - :n:`intros until @ident; destruct @ident`. If :n:`@ident` is not anymore - dependent in the goal after application of :n:`destruct`, it is erased - (to avoid erasure, use parentheses, as in :n:`destruct (@ident)`). + If :token:`ident` denotes a quantified variable of the conclusion + of the goal, then :n:`destruct @ident` behaves + as :n:`intros until @ident; destruct @ident`. If :token:`ident` is not + anymore dependent in the goal after application of :tacn:`destruct`, it + is erased (to avoid erasure, use parentheses, as in :n:`destruct (@ident)`). - + If term is a num, then destruct num behaves as intros until num - followed by destruct applied to the last introduced hypothesis. + If :token:`ident` is a hypothesis of the context, and :token:`ident` + is not anymore dependent in the goal after application + of :tacn:`destruct`, it is erased (to avoid erasure, use parentheses, as + in :n:`destruct (@ident)`). + + .. tacv:: destruct @num + + :n:`destruct @num` behaves as :n:`intros until @num` + followed by destruct applied to the last introduced hypothesis. .. note:: - For destruction of a numeral, use syntax destruct (num) (not + For destruction of a numeral, use syntax :n:`destruct (@num)` (not very interesting anyway). - + In case term is an hypothesis :n:`@ident` of the context, and :n:`@ident` - is not anymore dependent in the goal after application of :n:`destruct`, it - is erased (to avoid erasure, use parentheses, as in :n:`destruct (@ident)`). + .. tacv:: destruct @pattern - + The argument :n:`@term` can also be a pattern of which holes are denoted - by “_”. In this case, the tactic checks that all subterms matching the - pattern in the conclusion and the hypotheses are compatible and - performs case analysis using this subterm. + The argument of :tacn:`destruct` can also be a pattern of which holes are + denoted by “_”. In this case, the tactic checks that all subterms + matching the pattern in the conclusion and the hypotheses are compatible + and performs case analysis using this subterm. -.. tacv:: destruct {+, @term} + .. tacv:: destruct {+, @term} - This is a shortcut for :n:`destruct term; ...; destruct term`. + This is a shortcut for :n:`destruct @term; ...; destruct @term`. -.. tacv:: destruct @term as @disj_conj_intro_pattern + .. tacv:: destruct @term as @disj_conj_intro_pattern - This behaves as :n:`destruct @term` but uses the names in :n:`@intro_pattern` - to name the variables introduced in the context. The :n:`@intro_pattern` must - have the form :n:`[p11 ... p1n | ... | pm1 ... pmn ]` with `m` being the - number of constructors of the type of :n:`@term`. Each variable introduced - by :n:`destruct` in the context of the `i`-th goal gets its name from the - list :n:`pi1 ... pin` in order. If there are not enough names, - :n:`@destruct` invents names for the remaining variables to introduce. More - generally, the :n:`pij` can be any introduction pattern (see - :tacn:`intros`). This provides a concise notation for chaining destruction of - an hypothesis. + This behaves as :n:`destruct @term` but uses the names + in :token:`disj_conj_intro_pattern` to name the variables introduced in the + context. The :token:`disj_conj_intro_pattern` must have the + form :n:`[p11 ... p1n | ... | pm1 ... pmn ]` with ``m`` being the + number of constructors of the type of :token:`term`. Each variable + introduced by :tacn:`destruct` in the context of the ``i``-th goal + gets its name from the list :n:`pi1 ... pin` in order. If there are not + enough names, :tacn:`destruct` invents names for the remaining variables + to introduce. More generally, the :n:`pij` can be any introduction + pattern (see :tacn:`intros`). This provides a concise notation for + chaining destruction of a hypothesis. -.. tacv:: destruct @term eqn:@naming_intro_pattern + .. tacv:: destruct @term eqn:@naming_intro_pattern + :name: destruct ... eqn: - This behaves as :n:`destruct @term` but adds an equation between :n:`@term` - and the value that :n:`@term` takes in each of the possible cases. The name - of the equation is specified by :n:`@naming_intro_pattern` (see - :tacn:`intros`), in particular `?` can be used to let Coq generate a fresh - name. + This behaves as :n:`destruct @term` but adds an equation + between :token:`term` and the value that it takes in each of the + possible cases. The name of the equation is specified + by :token:`naming_intro_pattern` (see :tacn:`intros`), + in particular ``?`` can be used to let Coq generate a fresh name. -.. tacv:: destruct @term with @bindings_list + .. tacv:: destruct @term with @bindings_list - This behaves like :n:`destruct @term` providing explicit instances for the - dependent premises of the type of :n:`@term` (see :ref:`syntax of bindings <bindingslist>`). + This behaves like :n:`destruct @term` providing explicit instances for + the dependent premises of the type of :token:`term`. -.. tacv:: edestruct @term - :name: edestruct + .. tacv:: edestruct @term + :name: edestruct - This tactic behaves like :n:`destruct @term` except that it does not fail if - the instance of a dependent premises of the type of :n:`@term` is not - inferable. Instead, the unresolved instances are left as existential - variables to be inferred later, in the same way as :tacn:`eapply` does. + This tactic behaves like :n:`destruct @term` except that it does not + fail if the instance of a dependent premises of the type + of :token:`term` is not inferable. Instead, the unresolved instances + are left as existential variables to be inferred later, in the same way + as :tacn:`eapply` does. -.. tacv:: destruct @term using @term -.. tacv:: destruct @term using @term with @bindings_list + .. tacv:: destruct @term using @term {? with @bindings_list } - These are synonyms of :n:`induction @term using @term` and - :n:`induction @term using @term with @bindings_list`. + This is synonym of :n:`induction @term using @term {? with @bindings_list }`. -.. tacv:: destruct @term in @goal_occurrences + .. tacv:: destruct @term in @goal_occurrences - This syntax is used for selecting which occurrences of :n:`@term` the case - analysis has to be done on. The :n:`in @goal_occurrences` clause is an - occurrence clause whose syntax and behavior is described in - :ref:`occurences sets <occurencessets>`. + This syntax is used for selecting which occurrences of :token:`term` + the case analysis has to be done on. The :n:`in @goal_occurrences` + clause is an occurrence clause whose syntax and behavior is described + in :ref:`occurences sets <occurencessets>`. -.. tacv:: destruct @term with @bindings_list as @disj_conj_intro_pattern eqn:@naming_intro_pattern using @term with @bindings_list in @goal_occurrences -.. tacv:: edestruct @term with @bindings_list as @disj_conj_intro_pattern eqn:@naming_intro_pattern using @term with @bindings_list in @goal_occurrences + .. tacv:: destruct @term {? with @bindings_list } {? as @disj_conj_intro_pattern } {? eqn:@naming_intro_pattern } {? using @term {? with @bindings_list } } {? in @goal_occurrences } + edestruct @term {? with @bindings_list } {? as @disj_conj_intro_pattern } {? eqn:@naming_intro_pattern } {? using @term {? with @bindings_list } } {? in @goal_occurrences } - These are the general forms of :n:`destruct` and :n:`edestruct`. They combine - the effects of the `with`, `as`, `eqn:`, `using`, and `in` clauses. + These are the general forms of :tacn:`destruct` and :tacn:`edestruct`. + They combine the effects of the ``with``, ``as``, ``eqn:``, ``using``, + and ``in`` clauses. -.. tacv:: case term +.. tacn:: case term :name: case The tactic :n:`case` is a more basic tactic to perform case analysis without @@ -1557,7 +1586,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) For simple induction on a numeral, use syntax induction (num) (not very interesting anyway). - + In case term is an hypothesis :n:`@ident` of the context, and :n:`@ident` + + In case term is a hypothesis :n:`@ident` of the context, and :n:`@ident` is not anymore dependent in the goal after application of :n:`induction`, it is erased (to avoid erasure, use parentheses, as in :n:`induction (@ident)`). @@ -1567,6 +1596,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) performs induction using this subterm. .. example:: + .. coqtop:: reset all Lemma induction_test : forall n:nat, n = n -> n <= n. @@ -1636,6 +1666,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) those are generalized as well in the statement to prove. .. example:: + .. coqtop:: reset all Lemma comm x y : x + y = y + x. @@ -1744,6 +1775,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) still get enough information in the proofs. .. example:: + .. coqtop:: reset all Lemma le_minus : forall n:nat, n < 1 -> n = 0. @@ -1809,6 +1841,7 @@ and an explanation of the underlying technique. Note that this tactic is only available after a ``Require Import FunInd``. .. example:: + .. coqtop:: reset all Require Import FunInd. @@ -1845,9 +1878,7 @@ and an explanation of the underlying technique. :g:`Fixpoint` or :g:`Definition`. See :ref:`advanced-recursive-functions` for details. -See also: :ref:`advanced-recursive-functions` - :ref:`functional-scheme` - :tacn:`inversion` +.. seealso:: :ref:`advanced-recursive-functions`, :ref:`functional-scheme` and :tacn:`inversion` .. exn:: Cannot find induction information on @qualid. .. exn:: Not the right number of induction arguments. @@ -2008,7 +2039,7 @@ See also: :ref:`advanced-recursive-functions` the number of equalities newly generated. If it is smaller, fresh names are automatically generated to adjust the list of :n:`@intro_pattern` to the number of new equalities. The original equality is erased if it - corresponds to an hypothesis. + corresponds to a hypothesis. .. opt:: Structural Injection @@ -2279,8 +2310,8 @@ See also: :ref:`advanced-recursive-functions` As H occurs in the goal, we may want to reason by cases on its structure and so, we would like inversion tactics to substitute H by - the corresponding @term in constructor form. Neither Inversion nor - Inversion_clear make such a substitution. To have such a behavior we + the corresponding @term in constructor form. Neither :tacn:`inversion` nor + :n:`inversion_clear` do such a substitution. To have such a behavior we use the dependent inversion tactics: .. coqtop:: all @@ -2856,6 +2887,7 @@ the conversion in hypotheses :n:`{+ @ident}`. + A constant can be marked to be never unfolded by ``cbn`` or ``simpl``: .. example:: + .. coqtop:: all Arguments minus n m : simpl never. @@ -2868,6 +2900,7 @@ the conversion in hypotheses :n:`{+ @ident}`. ``/`` symbol in the argument list of the :cmd:`Arguments` vernacular command. .. example:: + .. coqtop:: all Definition fcomp A B C f (g : A -> B) (x : A) : C := f (g x). @@ -2880,6 +2913,7 @@ the conversion in hypotheses :n:`{+ @ident}`. always unfolded. .. example:: + .. coqtop:: all Definition volatile := fun x : nat => x. @@ -2890,6 +2924,7 @@ the conversion in hypotheses :n:`{+ @ident}`. such arguments. .. example:: + .. coqtop:: all Arguments minus !n !m. @@ -3168,7 +3203,7 @@ the :tacn:`auto` and :tacn:`trivial` tactics: .. opt:: Info Trivial .. opt:: Debug Trivial -See also: :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` +.. seealso:: :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` .. tacn:: eauto :name: eauto @@ -3180,6 +3215,7 @@ where :tacn:`auto` uses simple :tacn:`apply`). As a consequence, :tacn:`eauto` can solve such a goal: .. example:: + .. coqtop:: all Hint Resolve ex_intro. @@ -3198,7 +3234,7 @@ Note that ``ex_intro`` should be declared as a hint. .. opt:: Info Eauto .. opt:: Debug Eauto -See also: :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` +.. seealso:: :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` .. tacn:: autounfold with {+ @ident} @@ -3255,10 +3291,10 @@ command. Performs all the rewriting in the clause :n:`@clause`. The clause argument must not contain any ``type of`` nor ``value of``. -See also: :ref:`Hint-Rewrite <hintrewrite>` for feeding the database of lemmas used by -:tacn:`autorewrite`. +.. seealso:: -See also: :tacn:`autorewrite` for examples showing the use of this tactic. + :ref:`Hint-Rewrite <hintrewrite>` for feeding the database of lemmas used by + :tacn:`autorewrite` and :tacn:`autorewrite` for examples showing the use of this tactic. .. tacn:: easy :name: easy @@ -3554,7 +3590,7 @@ At Coq startup, only the core database is nonempty and can be used. :zarith: contains lemmas about binary signed integers from the directories theories/ZArith. When required, the module Omega also extends the database zarith with a high-cost hint that calls ``omega`` on equations - and inequalities in nat or Z. + and inequalities in ``nat`` or ``Z``. :bool: contains lemmas about booleans, mostly from directory theories/Bool. @@ -3564,7 +3600,7 @@ At Coq startup, only the core database is nonempty and can be used. :sets: contains lemmas about sets and relations from the directories Sets and Relations. -:typeclass_instances: contains all the type class instances declared in the +:typeclass_instances: contains all the typeclass instances declared in the environment, including those used for ``setoid_rewrite``, from the Classes directory. @@ -3693,7 +3729,7 @@ Setting implicit automation tactics In this case the tactic command typed by the user is equivalent to ``tactic``:sub:`1` ``;tactic``. - See also: ``Proof.`` in :ref:`proof-editing-mode`. + .. seealso:: :cmd:`Proof` in :ref:`proof-editing-mode`. .. cmdv:: Proof with tactic using {+ @ident} @@ -3748,6 +3784,7 @@ The following goal can be proved by :tacn:`tauto` whereas :tacn:`auto` would fail: .. example:: + .. coqtop:: reset all Goal forall (x:nat) (P:nat -> Prop), x = 0 \/ P x -> x <> 0 -> P x. @@ -3904,6 +3941,7 @@ equality must contain all the quantified variables in order for congruence to match against it. .. example:: + .. coqtop:: reset all Theorem T (A:Type) (f:A -> A) (g: A -> A -> A) a b: a=(f a) -> (g b (f a))=(f (f a)) -> (g a b)=(f (g b a)) -> (g a b)=a. @@ -3935,7 +3973,7 @@ match against it. discriminable equality but this proof could not be built in Coq because of dependently-typed functions. -.. exn:: Goal is solvable by congruence but some arguments are missing. Try congruence with ..., replacing metavariables by arbitrary terms. +.. exn:: Goal is solvable by congruence but some arguments are missing. Try congruence with {+ @term}, replacing metavariables by arbitrary terms. The decision procedure could solve the goal with the provision that additional arguments are supplied for some partially applied constructors. Any term of an @@ -3979,7 +4017,7 @@ succeeds, and results in an error otherwise. This tactic checks whether its arguments are unifiable, potentially instantiating existential variables. -.. exn:: Not unifiable. +.. exn:: Unable to unify @term with @term. .. tacv:: unify @term @term with @ident @@ -4165,8 +4203,9 @@ available after a ``Require Import FunInd``. .. tacv:: functional inversion @num - This does the same thing as intros until num thenfunctional inversion ident - where ident is the identifier for the last introduced hypothesis. + This does the same thing as :n:`intros until @num` folowed by + :n:`functional inversion @ident` where :token:`ident` is the + identifier for the last introduced hypothesis. .. tacv:: functional inversion ident qualid .. tacv:: functional inversion num qualid @@ -4273,7 +4312,7 @@ and :g:`Z` of binary integers. This tactic must be loaded by the command :name: ring_simplify The :n:`ring` tactic solves equations upon polynomial expressions of a ring -(or semi-ring) structure. It proceeds by normalizing both hand sides +(or semiring) structure. It proceeds by normalizing both hand sides of the equation (w.r.t. associativity, commutativity and distributivity, constant propagation) and comparing syntactically the results. @@ -4315,6 +4354,7 @@ declare new field structures. All declared field structures can be printed with the Print Fields command. .. example:: + .. coqtop:: reset all Require Import Reals. @@ -4325,8 +4365,10 @@ printed with the Print Fields command. intros; field. -See also: file plugins/setoid_ring/RealField.v for an example of instantiation, -theory theories/Reals for many examples of use of field. +.. seealso:: + + File plugins/setoid_ring/RealField.v for an example of instantiation, + theory theories/Reals for many examples of use of field. Non-logical tactics ------------------------ @@ -4426,6 +4468,7 @@ Simple tactic macros A simple example has more value than a long explanation: .. example:: + .. coqtop:: reset all Ltac Solve := simpl; intros; auto. @@ -4446,7 +4489,7 @@ user-defined tactics. other one can be automatically checked. .. [2] This corresponds to the cut rule of sequent calculus. .. [3] Reminder: opaque constants will not be expanded by δ reductions. -.. [4] The behavior of this tactic has much changed compared to the +.. [4] The behavior of this tactic has changed a lot compared to the versions available in the previous distributions (V6). This may cause significant changes in your theories to obtain the same result. As a drawback of the re-engineering of the code, this tactic has also been diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst index 0a517973c2..584193b9c6 100644 --- a/doc/sphinx/proof-engine/vernacular-commands.rst +++ b/doc/sphinx/proof-engine/vernacular-commands.rst @@ -246,7 +246,7 @@ Requests to the environment hypothesis introduced in the first subgoal (if a proof is in progress). - See also: Section :ref:`performingcomputations`. + .. seealso:: Section :ref:`performingcomputations`. .. cmd:: Compute @term @@ -255,7 +255,7 @@ Requests to the environment bytecode-based virtual machine. It is a shortcut for ``Eval vm_compute in`` :n:`@term`. - See also: Section :ref:`performingcomputations`. + .. seealso:: Section :ref:`performingcomputations`. .. cmd:: Print Assumptions @qualid @@ -521,7 +521,7 @@ Requests to the environment This command displays the full name of objects whose name is a prefix of the qualified identifier :n:`@qualid`, and consequently the |Coq| module in which they are defined. It searches for objects from the different - qualified name spaces of |Coq|: terms, modules, Ltac, etc. + qualified namespaces of |Coq|: terms, modules, Ltac, etc. .. example:: @@ -549,7 +549,7 @@ Requests to the environment As Locate but restricted to tactics. -See also: Section :ref:`locating-notations` +.. seealso:: Section :ref:`locating-notations` .. _loading-files: @@ -587,7 +587,9 @@ toplevel. This kind of file is called a *script* for |Coq|. The standard Display, while loading, the answers of |Coq| to each command (including tactics) contained in - the loaded file See also: Section :ref:`controlling-display`. + the loaded file. + + .. seealso:: Section :ref:`controlling-display`. .. exn:: Can’t find file @ident on loadpath. @@ -699,10 +701,7 @@ file is a particular case of module called *library file*. that the commands ``Import`` and ``Export`` alone can be used inside modules (see Section :ref:`Import <import_qualid>`). - - -See also: Chapter :ref:`thecoqcommands` - + .. seealso:: Chapter :ref:`thecoqcommands` .. cmd:: Print Libraries @@ -930,7 +929,7 @@ Quitting and debugging .. cmd:: Drop - This is used mostly as a debug facility by |Coq|’s implementors and does + This is used mostly as a debug facility by |Coq|’s implementers and does not concern the casual user. This command permits to leave |Coq| temporarily and enter the OCaml toplevel. The OCaml command: @@ -1097,8 +1096,10 @@ described first. The scope of :cmd:`Opaque` is limited to the current section, or current file, unless the variant :cmd:`Global Opaque` is used. - See also: sections :ref:`performingcomputations`, :ref:`tactics-automating`, - :ref:`proof-editing-mode` + .. seealso:: + + Sections :ref:`performingcomputations`, :ref:`tactics-automating`, + :ref:`proof-editing-mode` .. exn:: The reference @qualid was not found in the current environment. @@ -1130,8 +1131,10 @@ described first. There is no constant referred by :n:`@qualid` in the environment. - See also: sections :ref:`performingcomputations`, - :ref:`tactics-automating`, :ref:`proof-editing-mode` + .. seealso:: + + Sections :ref:`performingcomputations`, + :ref:`tactics-automating`, :ref:`proof-editing-mode` .. _vernac-strategy: @@ -1195,7 +1198,7 @@ described first. nothing prevents the user to also perform a ``Ltac`` `ident` ``:=`` `convtactic`. - See also: sections :ref:`performingcomputations` + .. seealso:: :ref:`performingcomputations` .. _controlling-locality-of-commands: diff --git a/doc/sphinx/user-extensions/proof-schemes.rst b/doc/sphinx/user-extensions/proof-schemes.rst index 838926d651..ab1edc0b27 100644 --- a/doc/sphinx/user-extensions/proof-schemes.rst +++ b/doc/sphinx/user-extensions/proof-schemes.rst @@ -40,8 +40,7 @@ induction for objects in type `identᵢ`. Induction scheme for tree and forest. - The definition of principle of mutual induction for tree and forest - over the sort Set is defined by the command: + A mutual induction principle for tree and forest in sort ``Set`` can be defined using the command .. coqtop:: none @@ -193,10 +192,12 @@ command generates the induction principle for each `identᵢ`, following the recursive structure and case analyses of the corresponding function identᵢ’. -Remark: There is a difference between obtaining an induction scheme by -using ``Functional Scheme`` on a function defined by ``Function`` or not. -Indeed, ``Function`` generally produces smaller principles, closer to the -definition written by the user. +.. warning:: + + There is a difference between induction schemes generated by the command + :cmd:`Functional Scheme` and these generated by the :cmd:`Function`. Indeed, + :cmd:`Function` generally produces smaller principles that are closer to how + a user would implement them. See :ref:`advanced-recursive-functions` for details. .. example:: @@ -257,11 +258,6 @@ definition written by the user. auto with arith. Qed. - Remark: There is a difference between obtaining an induction scheme - for a function by using ``Function`` (see :ref:`advanced-recursive-functions`) and by using - ``Functional Scheme`` after a normal definition using ``Fixpoint`` or - ``Definition``. See :ref:`advanced-recursive-functions` for details. - .. example:: Induction scheme for tree_size. @@ -298,15 +294,15 @@ definition written by the user. | cons t f' => (tree_size t + forest_size f') end. - Remark: Function generates itself non mutual induction principles - tree_size_ind and forest_size_ind: + Notice that the induction principles ``tree_size_ind`` and ``forest_size_ind`` + generated by ``Function`` are not mutual. .. coqtop:: all Check tree_size_ind. - The definition of mutual induction principles following the recursive - structure of `tree_size` and `forest_size` is defined by the command: + Mutual induction principles following the recursive structure of ``tree_size`` + and ``forest_size`` can be generated by the following command: .. coqtop:: all @@ -352,10 +348,8 @@ having inverted the instance with the tactic `inversion`. .. example:: - Let us consider the relation `Le` over natural numbers and the following - variable: - - .. original LaTeX had "Variable" instead of "Axiom", which generates an ugly warning + Consider the relation `Le` over natural numbers and the following + parameter ``P``: .. coqtop:: all @@ -363,7 +357,7 @@ having inverted the instance with the tactic `inversion`. | LeO : forall n:nat, Le 0 n | LeS : forall n m:nat, Le n m -> Le (S n) (S m). - Axiom P : nat -> nat -> Prop. + Parameter P : nat -> nat -> Prop. To generate the inversion lemma for the instance `(Le (S n) m)` and the sort `Prop`, we do: diff --git a/doc/sphinx/user-extensions/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst index dcefa293b1..5089a1b3e3 100644 --- a/doc/sphinx/user-extensions/syntax-extensions.rst +++ b/doc/sphinx/user-extensions/syntax-extensions.rst @@ -50,11 +50,11 @@ A notation is always surrounded by double quotes (except when the abbreviation has the form of an ordinary applicative expression; see :ref:`Abbreviations`). The notation is composed of *tokens* separated by spaces. Identifiers in the string (such as ``A`` and ``B``) are the *parameters* -of the notation. They must occur at least once each in the denoted term. The +of the notation. Each of them must occur at least once in the denoted term. The other elements of the string (such as ``/\``) are the *symbols*. An identifier can be used as a symbol but it must be surrounded by -simple quotes to avoid the confusion with a parameter. Similarly, +single quotes to avoid the confusion with a parameter. Similarly, every symbol of at least 3 characters and starting with a simple quote must be quoted (then it starts by two single quotes). Here is an example. @@ -119,7 +119,7 @@ command understands. Here is how the previous examples refine. Notation "A /\ B" := (and A B) (at level 80, right associativity). Notation "A \/ B" := (or A B) (at level 85, right associativity). -By default, a notation is considered non associative, but the +By default, a notation is considered nonassociative, but the precedence level is mandatory (except for special cases whose level is canonical). The level is either a number or the phrase ``next level`` whose meaning is obvious. @@ -139,14 +139,14 @@ instance define prefix notations. Notation "~ x" := (not x) (at level 75, right associativity). One can also define notations for incomplete terms, with the hole -expected to be inferred at typing time. +expected to be inferred during type checking. .. coqtop:: in Notation "x = y" := (@eq _ x y) (at level 70, no associativity). One can define *closed* notations whose both sides are symbols. In this case, -the default precedence level for the inner subexpression is 200, and the default +the default precedence level for the inner sub-expression is 200, and the default level for the notation itself is 0. .. coqtop:: in @@ -186,13 +186,13 @@ rules. Some simple left factorization work has to be done. Here is an example. Notation "x < y < z" := (x < y /\ y < z) (at level 70). In order to factorize the left part of the rules, the subexpression -referred by ``y`` has to be at the same level in both rules. However the +referred to by ``y`` has to be at the same level in both rules. However the default behavior puts ``y`` at the next level below 70 in the first rule -(``no associativity`` is the default), and at the level 200 in the second +(``no associativity`` is the default), and at level 200 in the second rule (``level 200`` is the default for inner expressions). To fix this, we need to force the parsing level of ``y``, as follows. -.. coqtop:: all +.. coqtop:: in Notation "x < y" := (lt x y) (at level 70). Notation "x < y < z" := (x < y /\ y < z) (at level 70, y at next level). @@ -209,7 +209,7 @@ of Coq predefined notations can be found in the chapter on :ref:`thecoqlibrary`. .. cmd:: Print Grammar pattern. This displays the state of the subparser of patterns (the parser used in the - grammar of the match with constructions). + grammar of the ``match with`` constructions). Displaying symbolic notations @@ -283,7 +283,7 @@ the possible following elements delimited by single quotes: (4 spaces in the example) - well-bracketed pairs of tokens of the form ``'[hv '`` and ``']'`` are - translated into horizontal-orelse-vertical printing boxes; if the + translated into horizontal-or-else-vertical printing boxes; if the content of the box does not fit on a single line, then every breaking point forces a newline and an extra indentation of the number of spaces given after the “ ``[``” is applied at the beginning of each @@ -295,8 +295,8 @@ the possible following elements delimited by single quotes: of the box, and an extra indentation of the number of spaces given after the “``[``” is applied at the beginning of each newline -Notations do not survive the end of sections. No typing of the denoted -expression is performed at definition time. Type-checking is done only +Notations disappear when a section is closed. No typing of the denoted +expression is performed at definition time. Type checking is done only at the time of use of the notation. .. note:: Sometimes, a notation is expected only for the parser. To do @@ -350,7 +350,7 @@ Simultaneous definition of terms and notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Thanks to reserved notations, the inductive, co-inductive, record, recursive and -corecursive definitions can benefit of customized notations. To do this, insert +corecursive definitions can benefit from customized notations. To do this, insert a ``where`` notation clause after the definition of the (co)inductive type or (co)recursive term (or after the definition of each of them in case of mutual definitions). The exact syntax is given by :token:`decl_notation` for inductive, @@ -359,17 +359,23 @@ for records. Here are examples: .. coqtop:: in - Inductive and (A B:Prop) : Prop := conj : A -> B -> A /\ B - where "A /\ B" := (and A B). + Reserved Notation "A & B" (at level 80). + +.. coqtop:: in + + Inductive and' (A B : Prop) : Prop := conj' : A -> B -> A & B + where "A & B" := (and' A B). + +.. coqtop:: in - Fixpoint plus (n m:nat) {struct n} : nat := - match n with - | O => m - | S p => S (p+m) - end + Fixpoint plus (n m : nat) {struct n} : nat := + match n with + | O => m + | S p => S (p+m) + end where "n + m" := (plus n m). -Displaying informations about notations +Displaying information about notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. opt:: Printing Notations @@ -519,7 +525,7 @@ is just an identifier, one could have said ``p at level 99 as strict pattern``. Note also that in the absence of a ``as ident``, ``as strict pattern`` or -``as pattern`` modifiers, the default is to consider subexpressions occurring +``as pattern`` modifiers, the default is to consider sub-expressions occurring in binding position and parsed as terms to be ``as ident``. .. _NotationsWithBinders: @@ -565,7 +571,7 @@ confused with the three-dots notation “``…``” used in this manual to denot a sequence of arbitrary size. On the left-hand side, the part “``x s .. s y``” of the notation parses -any number of times (but at least one time) a sequence of expressions +any number of times (but at least once) a sequence of expressions separated by the sequence of tokens ``s`` (in the example, ``s`` is just “``;``”). The right-hand side must contain a subterm of the form either @@ -608,7 +614,7 @@ Notations with recursive patterns involving binders Recursive notations can also be used with binders. The basic example is: -.. coqtop:: all +.. coqtop:: in Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..)) @@ -627,7 +633,7 @@ repeatedly nested as many times as the number of binders generated. If ever the generalization operator ``'`` (see :ref:`implicit-generalization`) is used in the binding list, the added binders are taken into account too. -Binders parsing exist in two flavors. If ``x`` and ``y`` are marked as binder, +There are two flavors of binder parsing. If ``x`` and ``y`` are marked as binder, then a sequence such as :g:`a b c : T` will be accepted and interpreted as the sequence of binders :g:`(a:T) (b:T) (c:T)`. For instance, in the notation above, the syntax :g:`exists a b : nat, a = b` is valid. @@ -650,7 +656,7 @@ example of recursive notation with closed binders: A recursive pattern for binders can be used in position of a recursive pattern for terms. Here is an example: -.. coqtop:: in +.. coqtop:: in Notation "'FUNAPP' x .. y , f" := (fun x => .. (fun y => (.. (f x) ..) y ) ..) @@ -691,6 +697,157 @@ side. E.g.: Notation "'apply_id' f a1 .. an" := (.. (f a1) .. an) (at level 10, f ident, a1, an at level 9). +Custom entries +~~~~~~~~~~~~~~ + +.. cmd:: Declare Custom Entry @ident + + This command allows to define new grammar entries, called *custom + entries*, that can later be referred to using the entry name + :n:`custom @ident`. + +.. example:: + + For instance, we may want to define an ad hoc + parser for arithmetical operations and proceed as follows: + + .. coqtop:: all + + Inductive Expr := + | One : Expr + | Mul : Expr -> Expr -> Expr + | Add : Expr -> Expr -> Expr. + + Declare Custom Entry expr. + Notation "[ e ]" := e (e custom expr at level 2). + Notation "1" := One (in custom expr at level 0). + Notation "x y" := (Mul x y) (in custom expr at level 1, left associativity). + Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). + Notation "( x )" := x (in custom expr, x at level 2). + Notation "{ x }" := x (in custom expr, x constr). + Notation "x" := x (in custom expr at level 0, x ident). + + Axiom f : nat -> Expr. + Check fun x y z => [1 + y z + {f x}]. + Unset Printing Notations. + Check fun x y z => [1 + y z + {f x}]. + Set Printing Notations. + Check fun e => match e with + | [1 + 1] => [1] + | [x y + z] => [x + y z] + | y => [y + e] + end. + +Custom entries have levels, like the main grammar of terms and grammar +of patterns have. The lower level is 0 and this is the level used by +default to put rules delimited with tokens on both ends. The level is +left to be inferred by Coq when using :n:`in custom @ident`. The +level is otherwise given explicitly by using the syntax +:n:`in custom @ident at level @num`, where :n:`@num` refers to the level. + +Levels are cumulative: a notation at level ``n`` of which the left end +is a term shall use rules at level less than ``n`` to parse this +sub-term. More precisely, it shall use rules at level strictly less +than ``n`` if the rule is declared with ``right associativity`` and +rules at level less or equal than ``n`` if the rule is declared with +``left associativity``. Similarly, a notation at level ``n`` of which +the right end is a term shall use by default rules at level strictly +less than ``n`` to parse this sub-term if the rule is declared left +associative and rules at level less or equal than ``n`` if the rule is +declared right associative. This is what happens for instance in the +rule + +.. coqtop:: in + + Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). + +where ``x`` is any expression parsed in entry +``expr`` at level less or equal than ``2`` (including, recursively, +the given rule) and ``y`` is any expression parsed in entry ``expr`` +at level strictly less than ``2``. + +Rules associated to an entry can refer different sub-entries. The +grammar entry name ``constr`` can be used to refer to the main grammar +of term as in the rule + +.. coqtop:: in + + Notation "{ x }" := x (in custom expr at level 0, x constr). + +which indicates that the subterm ``x`` should be +parsed using the main grammar. If not indicated, the level is computed +as for notations in ``constr``, e.g. using 200 as default level for +inner sub-expressions. The level can otherwise be indicated explicitly +by using ``constr at level n`` for some ``n``, or ``constr at next +level``. + +Conversely, custom entries can be used to parse sub-expressions of the +main grammar, or from another custom entry as is the case in + +.. coqtop:: in + + Notation "[ e ]" := e (e custom expr at level 2). + +to indicate that ``e`` has to be parsed at level ``2`` of the grammar +associated to the custom entry ``expr``. The level can be omitted, as in + +.. coqtop:: in + + Notation "[ e ]" := e (e custom expr)`. + +in which case Coq tries to infer it. + +In the absence of an explicit entry for parsing or printing a +sub-expression of a notation in a custom entry, the default is to +consider that this sub-expression is parsed or printed in the same +custom entry where the notation is defined. In particular, if ``x at +level n`` is used for a sub-expression of a notation defined in custom +entry ``foo``, it shall be understood the same as ``x custom foo at +level n``. + +In general, rules are required to be *productive* on the right-hand +side, i.e. that they are bound to an expression which is not +reduced to a single variable. If the rule is not productive on the +right-hand side, as it is the case above for + +.. coqtop:: in + + Notation "( x )" := x (in custom expr at level 0, x at level 2). + +and + +.. coqtop:: in + + Notation "{ x }" := x (in custom expr at level 0, x constr). + +it is used as a *grammar coercion* which means that it is used to parse or +print an expression which is not available in the current grammar at the +current level of parsing or printing for this grammar but which is available +in another grammar or in another level of the current grammar. For instance, + +.. coqtop:: in + + Notation "( x )" := x (in custom expr at level 0, x at level 2). + +tells that parentheses can be inserted to parse or print an expression +declared at level ``2`` of ``expr`` whenever this expression is +expected to be used as a subterm at level 0 or 1. This allows for +instance to parse and print :g:`Add x y` as a subterm of :g:`Mul (Add +x y) z` using the syntax ``(x + y) z``. Similarly, + +.. coqtop:: in + + Notation "{ x }" := x (in custom expr at level 0, x constr). + +gives a way to let any arbitrary expression which is not handled by the +custom entry ``expr`` be parsed or printed by the main grammar of term +up to the insertion of a pair of curly brackets. + +.. cmd:: Print Grammar @ident. + + This displays the state of the grammar for terms and grammar for + patterns associated to the custom entry :token:`ident`. + Summary ~~~~~~~ @@ -699,8 +856,8 @@ Summary Syntax of notations +++++++++++++++++++ -The different syntactic variants of the command Notation are given on the -following figure. The optional :production:`scope` is described in +The different syntactic forms taken by the commands declaring +notations are given below. The optional :production:`scope` is described in :ref:`Scopes`. .. productionlist:: coq @@ -711,33 +868,44 @@ following figure. The optional :production:`scope` is described in : | CoInductive `ind_body` [`decl_notation`] with … with `ind_body` [`decl_notation`]. : | Fixpoint `fix_body` [`decl_notation`] with … with `fix_body` [`decl_notation`]. : | CoFixpoint `cofix_body` [`decl_notation`] with … with `cofix_body` [`decl_notation`]. + : | [Local] Declare Custom Entry `ident`. decl_notation : [where `string` := `term` [: `scope`] and … and `string` := `term` [: `scope`]]. - modifiers : at level `natural` - : | `ident` , … , `ident` at level `natural` [`binderinterp`] + modifiers : at level `num` + : in custom `ident` + : in custom `ident` at level `num` + : | `ident` , … , `ident` at level `num` [`binderinterp`] : | `ident` , … , `ident` at next level [`binderinterp`] - : | `ident` ident - : | `ident` global - : | `ident` bigint - : | `ident` [strict] pattern [at level `natural`] - : | `ident` binder - : | `ident` closed binder + : | `ident` `explicit_subentry` : | left associativity : | right associativity : | no associativity : | only parsing : | only printing : | format `string` + explicit_subentry : ident + : | global + : | bigint + : | [strict] pattern [at level `num`] + : | binder + : | closed binder + : | constr [`binderinterp`] + : | constr at level `num` [`binderinterp`] + : | constr at next level [`binderinterp`] + : | custom [`binderinterp`] + : | custom at level `num` [`binderinterp`] + : | custom at next level [`binderinterp`] binderinterp : as ident : | as pattern : | as strict pattern .. note:: No typing of the denoted expression is performed at definition - time. Type-checking is done only at the time of use of the notation. + time. Type checking is done only at the time of use of the notation. -.. note:: Many examples of Notation may be found in the files composing +.. note:: Some examples of Notation may be found in the files composing the initial state of Coq (see directory :file:`$COQLIB/theories/Init`). -.. note:: The notation ``"{ x }"`` has a special status in such a way that +.. note:: The notation ``"{ x }"`` has a special status in the main grammars of + terms and patterns so that complex notations of the form ``"x + { y }"`` or ``"x * { y }"`` can be nested with correct precedences. Especially, every notation involving a pattern of the form ``"{ x }"`` is parsed as a notation where the @@ -754,22 +922,27 @@ following figure. The optional :production:`scope` is described in Persistence of notations ++++++++++++++++++++++++ -Notations do not survive the end of sections. +Notations disappear when a section is closed. .. cmd:: Local Notation @notation Notations survive modules unless the command ``Local Notation`` is used instead of :cmd:`Notation`. +.. cmd:: Local Declare Custom Entry @ident + + Custom entries survive modules unless the command ``Local Declare + Custom Entry`` is used instead of :cmd:`Declare Custom Entry`. + .. _Scopes: Interpretation scopes ---------------------- An *interpretation scope* is a set of notations for terms with their -interpretation. Interpretation scopes provide a weak, purely -syntactical form of notations overloading: the same notation, for -instance the infix symbol ``+`` can be used to denote distinct +interpretations. Interpretation scopes provide a weak, purely +syntactical form of notation overloading: the same notation, for +instance the infix symbol ``+``, can be used to denote distinct definitions of the additive operator. Depending on which interpretation scopes are currently open, the interpretation is different. Interpretation scopes can include an interpretation for numerals and @@ -780,7 +953,7 @@ See :ref:`above <NotationSyntax>` for the syntax of notations including the possibility to declare them in a given scope. Here is a typical example which declares the notation for conjunction in the scope ``type_scope``. -.. coqdoc:: +.. coqtop:: in Notation "A /\ B" := (and A B) : type_scope. @@ -790,10 +963,10 @@ declares the notation for conjunction in the scope ``type_scope``. Global interpretation rules for notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -At any time, the interpretation of a notation for term is done within +At any time, the interpretation of a notation for a term is done within a *stack* of interpretation scopes and lonely notations. In case a notation has several interpretations, the actual interpretation is the -one defined by (or in) the more recently declared (or open) lonely +one defined by (or in) the more recently declared (or opened) lonely notation (or interpretation scope) which defines this notation. Typically if a given notation is defined in some scope ``scope`` but has also an interpretation not assigned to a scope, then, if ``scope`` is open @@ -819,7 +992,7 @@ lonely notations. These scopes, in opening order, are ``core_scope``, stack by using the command :n:`Close Scope @scope`. Notice that this command does not only cancel the last :n:`Open Scope @scope` - but all the invocations of it. + but all its invocations. .. note:: ``Open Scope`` and ``Close Scope`` do not survive the end of sections where they occur. When defined outside of a section, they are exported @@ -899,11 +1072,11 @@ Binding arguments of a constant to an interpretation scope the scope is limited to the argument itself. It does not propagate to subterms but the subterms that, after interpretation of the notation, turn to be themselves arguments of a reference are interpreted - accordingly to the arguments scopes bound to this reference. + accordingly to the argument scopes bound to this reference. .. cmdv:: Arguments @qualid : clear scopes - Arguments scopes can be cleared with :n:`Arguments @qualid : clear scopes`. + This command can be used to clear argument scopes of :token:`qualid`. .. cmdv:: Arguments @qualid {+ @name%scope} : extra scopes @@ -1010,7 +1183,7 @@ The ``function_scope`` interpretation scope .. index:: function_scope -The scope ``function_scope`` also has a special status. +The scope ``function_scope`` also has a special status. It is temporarily activated each time the argument of a global reference is recognized to be a ``Funclass`` istance, i.e., of type :g:`forall x:A, B` or :g:`A -> B`. @@ -1025,34 +1198,34 @@ Scopes` or :cmd:`Print Scope`. ``type_scope`` This scope includes infix * for product types and infix + for sum types. It - is delimited by key ``type``, and bound to the coercion class + is delimited by the key ``type``, and bound to the coercion class ``Sortclass``, as described above. ``function_scope`` - This scope is delimited by key ``function``, and bound to the coercion class + This scope is delimited by the key ``function``, and bound to the coercion class ``Funclass``, as described above. ``nat_scope`` This scope includes the standard arithmetical operators and relations on type nat. Positive numerals in this scope are mapped to their canonical - representent built from :g:`O` and :g:`S`. The scope is delimited by key + representent built from :g:`O` and :g:`S`. The scope is delimited by the key ``nat``, and bound to the type :g:`nat` (see above). ``N_scope`` This scope includes the standard arithmetical operators and relations on - type :g:`N` (binary natural numbers). It is delimited by key ``N`` and comes + type :g:`N` (binary natural numbers). It is delimited by the key ``N`` and comes with an interpretation for numerals as closed terms of type :g:`N`. ``Z_scope`` This scope includes the standard arithmetical operators and relations on - type :g:`Z` (binary integer numbers). It is delimited by key ``Z`` and comes - with an interpretation for numerals as closed term of type :g:`Z`. + type :g:`Z` (binary integer numbers). It is delimited by the key ``Z`` and comes + with an interpretation for numerals as closed terms of type :g:`Z`. ``positive_scope`` This scope includes the standard arithmetical operators and relations on type :g:`positive` (binary strictly positive numbers). It is delimited by key ``positive`` and comes with an interpretation for numerals as closed - term of type :g:`positive`. + terms of type :g:`positive`. ``Q_scope`` This scope includes the standard arithmetical operators and relations on @@ -1069,20 +1242,20 @@ Scopes` or :cmd:`Print Scope`. ``real_scope`` This scope includes the standard arithmetical operators and relations on - type :g:`R` (axiomatic real numbers). It is delimited by key ``R`` and comes + type :g:`R` (axiomatic real numbers). It is delimited by the key ``R`` and comes with an interpretation for numerals using the :g:`IZR` morphism from binary integer numbers to :g:`R`. ``bool_scope`` - This scope includes notations for the boolean operators. It is delimited by + This scope includes notations for the boolean operators. It is delimited by the key ``bool``, and bound to the type :g:`bool` (see above). ``list_scope`` - This scope includes notations for the list operators. It is delimited by key + This scope includes notations for the list operators. It is delimited by the key ``list``, and bound to the type :g:`list` (see above). ``core_scope`` - This scope includes the notation for pairs. It is delimited by key ``core``. + This scope includes the notation for pairs. It is delimited by the key ``core``. ``string_scope`` This scope includes notation for strings as elements of the type string. @@ -1101,7 +1274,7 @@ Scopes` or :cmd:`Print Scope`. the ASCII code 34), all of them being represented in the type :g:`ascii`. -Displaying informations about scopes +Displaying information about scopes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Print Visibility @@ -1109,7 +1282,7 @@ Displaying informations about scopes This displays the current stack of notations in scopes and lonely notations that is used to interpret a notation. The top of the stack is displayed last. Notations in scopes whose interpretation is hidden - by the same notation in a more recently open scope are not displayed. + by the same notation in a more recently opened scope are not displayed. Hence each notation is displayed only once. .. cmdv:: Print Visibility @scope @@ -1122,13 +1295,13 @@ Displaying informations about scopes .. cmd:: Print Scopes This displays all the notations, delimiting keys and corresponding - class of all the existing interpretation scopes. It also displays the + classes of all the existing interpretation scopes. It also displays the lonely notations. .. cmdv:: Print Scope @scope :name: Print Scope - This displays all the notations defined in interpretation scope :token:`scope`. + This displays all the notations defined in the interpretation scope :token:`scope`. It also displays the delimiting key if any and the class to which the scope is bound, if any. @@ -1170,13 +1343,13 @@ Abbreviations much as possible by the Coq printers unless the modifier ``(only parsing)`` is given. - Abbreviations are bound to an absolute name as an ordinary definition - is, and they can be referred by qualified names too. + An abbreviation is bound to an absolute name as an ordinary definition is + and it also can be referred to by a qualified name. Abbreviations are syntactic in the sense that they are bound to expressions which are not typed at the time of the definition of the - abbreviation but at the time it is used. Especially, abbreviations can - be bound to terms with holes (i.e. with “``_``”). For example: + abbreviation but at the time they are used. Especially, abbreviations + can be bound to terms with holes (i.e. with “``_``”). For example: .. coqtop:: none reset @@ -1186,14 +1359,17 @@ Abbreviations .. coqtop:: in Definition explicit_id (A:Set) (a:A) := a. + + .. coqtop:: in + Notation id := (explicit_id _). .. coqtop:: all Check (id 0). - Abbreviations do not survive the end of sections. No typing of the - denoted expression is performed at definition time. Type-checking is + Abbreviations disappear when a section is closed. No typing of the + denoted expression is performed at definition time. Type checking is done only at the time of use of the abbreviation. .. _TacticNotation: @@ -1201,13 +1377,12 @@ Abbreviations Tactic Notations ----------------- -Tactic notations allow to customize the syntax of the tactics of the -tactic language. Tactic notations obey the following syntax: +Tactic notations allow to customize the syntax of tactics. They have the following syntax: .. productionlist:: coq tacn : Tactic Notation [`tactic_level`] [`prod_item` … `prod_item`] := `tactic`. prod_item : `string` | `tactic_argument_type`(`ident`) - tactic_level : (at level `natural`) + tactic_level : (at level `num`) tactic_argument_type : ident | simple_intropattern | reference : | hyp | hyp_list | ne_hyp_list : | constr | uconstr | constr_list | ne_constr_list @@ -1224,7 +1399,7 @@ tactic language. Tactic notations obey the following syntax: a terminal symbol, i.e. a string, for the first production item. The tactic level indicates the parsing precedence of the tactic notation. This information is particularly relevant for notations of tacticals. - Levels 0 to 5 are available (default is 0). + Levels 0 to 5 are available (default is 5). .. cmd:: Print Grammar tactic @@ -1251,12 +1426,12 @@ tactic language. Tactic notations obey the following syntax: * - ``simple_intropattern`` - intro_pattern - - an intro_pattern + - an intro pattern - intros * - ``hyp`` - identifier - - an hypothesis defined in context + - a hypothesis defined in context - clear * - ``reference`` @@ -1305,7 +1480,7 @@ tactic language. Tactic notations obey the following syntax: - .. note:: In order to be bound in tactic definitions, each syntactic - entry for argument type must include the case of simple L tac + entry for argument type must include the case of a simple |Ltac| identifier as part of what it parses. This is naturally the case for ``ident``, ``simple_intropattern``, ``reference``, ``constr``, ... but not for ``integer``. This is the reason for introducing a special entry ``int_or_var`` which @@ -1319,16 +1494,16 @@ tactic language. Tactic notations obey the following syntax: .. cmdv:: Local Tactic Notation - Tactic notations do not survive the end of sections. They survive - modules unless the command Local Tactic Notation is used instead of - Tactic Notation. + Tactic notations disappear when a section is closed. They survive when + a module is closed unless the command ``Local Tactic Notation`` is used instead + of :cmd:`Tactic Notation`. .. rubric:: Footnotes .. [#and_or_levels] which are the levels effectively chosen in the current implementation of Coq -.. [#no_associativity] Coq accepts notations declared as ``no associative`` but the parser on - which Coq is built, namely Camlp4, currently does not implement the - ``no associativity`` and replaces it by a ``left associativity``; hence it is - the same for Coq: ``no associativity`` is in fact ``left associativity``. +.. [#no_associativity] Coq accepts notations declared as nonassociative but the parser on + which Coq is built, namely Camlp5, currently does not implement ``no associativity`` and + replaces it with ``left associativity``; hence it is the same for Coq: ``no associativity`` + is in fact ``left associativity`` for the purposes of parsing diff --git a/doc/tools/coqrst/coqdomain.py b/doc/tools/coqrst/coqdomain.py index 610805e8f5..40554c3ca3 100644 --- a/doc/tools/coqrst/coqdomain.py +++ b/doc/tools/coqrst/coqdomain.py @@ -454,7 +454,7 @@ def NotationRole(role, rawtext, text, lineno, inliner, options={}, content=[]): it names the introduced hypothesis :token:`ident`. Note that this example also uses ``:token:``. That's because ``ident`` is - defined in the the Coq manual as a grammar production, and ``:token:`` + defined in the Coq manual as a grammar production, and ``:token:`` creates a link to that. When referring to a placeholder that happens to be a grammar production, ``:token:`…``` is typically preferable to ``:n:`@…```. """ @@ -576,6 +576,9 @@ class ExampleDirective(BaseAdmonition): http://docutils.sourceforge.net/docs/ref/rst/directives.html#generic-admonition for more details. + Optionally, any text immediately following the ``.. example::`` header is + used as the example's title. + Example:: .. example:: Adding a hint to a database @@ -588,13 +591,14 @@ class ExampleDirective(BaseAdmonition): """ node_class = nodes.admonition directive_name = "example" + optional_arguments = 1 def run(self): # ‘BaseAdmonition’ checks whether ‘node_class’ is ‘nodes.admonition’, # and uses arguments[0] as the title in that case (in other cases, the # title is unset, and it is instead set in the HTML visitor). - assert not self.arguments # Arguments have been parsed as content - self.arguments = ['Example'] + assert len(self.arguments) <= 1 + self.arguments = [": ".join(['Example'] + self.arguments)] self.options['classes'] = ['admonition', 'note'] return super().run() diff --git a/grammar/q_util.mli b/grammar/q_util.mli index 323a12357d..f3af318b60 100644 --- a/grammar/q_util.mli +++ b/grammar/q_util.mli @@ -48,3 +48,5 @@ val mlexpr_of_prod_entry_key : (string -> MLast.expr) -> user_symbol -> MLast.ex val type_of_user_symbol : user_symbol -> argument_type val parse_user_entry : string -> string -> user_symbol + +val mlexpr_of_symbol : user_symbol -> MLast.expr diff --git a/grammar/q_util.mlp b/grammar/q_util.mlp index 0b8d7fda7a..0e2bf55d86 100644 --- a/grammar/q_util.mlp +++ b/grammar/q_util.mlp @@ -128,3 +128,17 @@ let rec parse_user_entry s sep = let s = match s with "hyp" -> "var" | _ -> s in check_separator sep; Uentry s + +let rec mlexpr_of_symbol = function +| Ulist1 s -> <:expr< Extend.TUlist1 $mlexpr_of_symbol s$ >> +| Ulist1sep (s,sep) -> <:expr< Extend.TUlist1sep $mlexpr_of_symbol s$ $str:sep$ >> +| Ulist0 s -> <:expr< Extend.TUlist0 $mlexpr_of_symbol s$ >> +| Ulist0sep (s,sep) -> <:expr< Extend.TUlist0sep $mlexpr_of_symbol s$ $str:sep$ >> +| Uopt s -> <:expr< Extend.TUopt $mlexpr_of_symbol s$ >> +| Uentry e -> + let wit = <:expr< $lid:"wit_"^e$ >> in + <:expr< Extend.TUentry (Genarg.get_arg_tag $wit$) >> +| Uentryl (e, l) -> + assert (e = "tactic"); + let wit = <:expr< $lid:"wit_"^e$ >> in + <:expr< Extend.TUentryl (Genarg.get_arg_tag $wit$) $mlexpr_of_int l$>> diff --git a/grammar/tacextend.mlp b/grammar/tacextend.mlp index 02da61ef77..07239e7af0 100644 --- a/grammar/tacextend.mlp +++ b/grammar/tacextend.mlp @@ -15,20 +15,6 @@ open Argextend let plugin_name = <:expr< __coq_plugin_name >> -let rec mlexpr_of_symbol = function -| Ulist1 s -> <:expr< Extend.TUlist1 $mlexpr_of_symbol s$ >> -| Ulist1sep (s,sep) -> <:expr< Extend.TUlist1sep $mlexpr_of_symbol s$ $str:sep$ >> -| Ulist0 s -> <:expr< Extend.TUlist0 $mlexpr_of_symbol s$ >> -| Ulist0sep (s,sep) -> <:expr< Extend.TUlist0sep $mlexpr_of_symbol s$ $str:sep$ >> -| Uopt s -> <:expr< Extend.TUopt $mlexpr_of_symbol s$ >> -| Uentry e -> - let wit = <:expr< $lid:"wit_"^e$ >> in - <:expr< Extend.TUentry (Genarg.get_arg_tag $wit$) >> -| Uentryl (e, l) -> - assert (e = "tactic"); - let wit = <:expr< $lid:"wit_"^e$ >> in - <:expr< Extend.TUentryl (Genarg.get_arg_tag $wit$) $mlexpr_of_int l$>> - let rec mlexpr_of_clause = function | [] -> <:expr< TyNil >> | ExtTerminal s :: cl -> <:expr< TyIdent($str:s$, $mlexpr_of_clause cl$) >> diff --git a/grammar/vernacextend.mlp b/grammar/vernacextend.mlp index a2872d07f6..f30c96a7f5 100644 --- a/grammar/vernacextend.mlp +++ b/grammar/vernacextend.mlp @@ -14,134 +14,42 @@ open Q_util open Argextend type rule = { - r_head : string option; - (** The first terminal grammar token *) r_patt : extend_token list; (** The remaining tokens of the parsing rule *) r_class : MLast.expr option; (** An optional classifier for the STM *) r_branch : MLast.expr; (** The action performed by this rule. *) - r_depr : unit option; + r_depr : bool; (** Whether this entry is deprecated *) } -(** Quotation difference for match clauses *) - -let default_patt loc = - (<:patt< _ >>, ploc_vala None, <:expr< failwith "Extension: cannot occur" >>) - -let make_fun loc cl = - let l = cl @ [default_patt loc] in - MLast.ExFun (loc, ploc_vala l) (* correspond to <:expr< fun [ $list:l$ ] >> *) - -let rec make_patt = function - | [] -> <:patt< [] >> - | ExtNonTerminal (_, Some p) :: l -> - <:patt< [ $lid:p$ :: $make_patt l$ ] >> - | _::l -> make_patt l - -let rec make_let e = function - | [] -> e - | ExtNonTerminal (g, Some p) :: l -> - let t = type_of_user_symbol g in - let loc = MLast.loc_of_expr e in - let e = make_let e l in - <:expr< let $lid:p$ = Genarg.out_gen $make_rawwit loc t$ $lid:p$ in $e$ >> - | _::l -> make_let e l - -let make_clause { r_patt = pt; r_branch = e; } = - (make_patt pt, - ploc_vala None, - make_let e pt) - -(* To avoid warnings *) -let mk_ignore c pt = - let fold accu = function - | ExtNonTerminal (_, Some p) -> p :: accu - | _ -> accu - in - let names = List.fold_left fold [] pt in - let fold accu id = <:expr< let _ = $lid:id$ in $accu$ >> in - let names = List.fold_left fold <:expr< () >> names in - <:expr< do { let _ = $names$ in $c$ } >> - -let make_clause_classifier cg s { r_patt = pt; r_class = c; } = - match c ,cg with - | Some c, _ -> - (make_patt pt, - ploc_vala None, - make_let (mk_ignore c pt) pt) - | None, Some cg -> - (make_patt pt, - ploc_vala None, - <:expr< fun loc -> $cg$ $str:s$ >>) - | None, None -> prerr_endline - (("Vernac entry \""^s^"\" misses a classifier. "^ - "A classifier is a function that returns an expression "^ - "of type vernac_classification (see Vernacexpr). You can: ") ^ - "- " ^ ( - ("Use '... EXTEND "^s^" CLASSIFIED AS QUERY ...' if the "^ - "new vernacular command does not alter the system state;"))^ "\n" ^ - "- " ^ ( - ("Use '... EXTEND "^s^" CLASSIFIED AS SIDEFF ...' if the "^ - "new vernacular command alters the system state but not the "^ - "parser nor it starts a proof or ends one;"))^ "\n" ^ - "- " ^ ( - ("Use '... EXTEND "^s^" CLASSIFIED BY f ...' to specify "^ - "a global function f. The function f will be called passing "^ - "\""^s^"\" as the only argument;")) ^ "\n" ^ - "- " ^ ( - "Add a specific classifier in each clause using the syntax:" - ^ "\n" ^("'[...] => [ f ] -> [...]'. "))^ "\n" ^ - ("Specific classifiers have precedence over global "^ - "classifiers. Only one classifier is called.") ^ "\n"); - (make_patt pt, - ploc_vala None, - <:expr< fun () -> ( CErrors.anomaly (Pp.str "No classification given for command " ^ s ) ) >>) - -let make_fun_clauses loc s l = - let map c = - let depr = match c.r_depr with - | None -> false - | Some () -> true - in - let cl = make_fun loc [make_clause c] in - <:expr< ($mlexpr_of_bool depr$, $cl$)>> - in - mlexpr_of_list map l - -let make_fun_classifiers loc s c l = - let cl = List.map (fun x -> make_fun loc [make_clause_classifier c s x]) l in - mlexpr_of_list (fun x -> x) cl - -let make_prod_item = function - | ExtTerminal s -> <:expr< Egramml.GramTerminal $str:s$ >> - | ExtNonTerminal (g, ido) -> - let nt = type_of_user_symbol g in - let base s = <:expr< Pcoq.genarg_grammar ($mk_extraarg loc s$) >> in - let typ = match ido with None -> None | Some _ -> Some nt in - <:expr< Egramml.GramNonTerminal ( Loc.tag ( $mlexpr_of_option (make_rawwit loc) typ$ , - $mlexpr_of_prod_entry_key base g$ ) ) >> - -let mlexpr_of_clause cl = - let mkexpr { r_head = a; r_patt = b; } = match a with - | None -> mlexpr_of_list make_prod_item b - | Some a -> mlexpr_of_list make_prod_item (ExtTerminal a :: b) - in - mlexpr_of_list mkexpr cl +let rec make_patt r = function +| [] -> r +| ExtNonTerminal (_, Some p) :: l -> <:expr< fun $lid:p$ -> $make_patt r l$ >> +| ExtNonTerminal (_, None) :: l -> <:expr< fun _ -> $make_patt r l$ >> +| ExtTerminal _ :: l -> make_patt r l + +let rec mlexpr_of_clause = function +| [] -> <:expr< Vernacentries.TyNil >> +| ExtTerminal s :: cl -> <:expr< Vernacentries.TyTerminal ($str:s$, $mlexpr_of_clause cl$) >> +| ExtNonTerminal (g, id) :: cl -> + let id = mlexpr_of_option mlexpr_of_string id in + <:expr< Vernacentries.TyNonTerminal ($id$, $mlexpr_of_symbol g$, $mlexpr_of_clause cl$) >> + +let make_rule r = + let ty = mlexpr_of_clause r.r_patt in + let cmd = make_patt r.r_branch r.r_patt in + let make_classifier c = make_patt c r.r_patt in + let classif = mlexpr_of_option make_classifier r.r_class in + <:expr< Vernacentries.TyML ($mlexpr_of_bool r.r_depr$, $ty$, $cmd$, $classif$) >> let declare_command loc s c nt cl = let se = mlexpr_of_string s in - let gl = mlexpr_of_clause cl in - let funcl = make_fun_clauses loc s cl in - let classl = make_fun_classifiers loc s c cl in + let c = mlexpr_of_option (fun x -> x) c in + let rules = mlexpr_of_list make_rule cl in declare_str_items loc - [ <:str_item< do { - CList.iteri (fun i (depr, f) -> Vernacinterp.vinterp_add depr ($se$, i) f) $funcl$; - CList.iteri (fun i f -> Vernac_classifier.declare_vernac_classifier ($se$, i) f) $classl$; - CList.iteri (fun i r -> Egramml.extend_vernac_command_grammar ($se$, i) $nt$ r) $gl$; - } >> ] + [ <:str_item< Vernacentries.vernac_extend ?{ classifier = $c$ } ~{ command = $se$ } ?{ entry = $nt$ } $rules$ >> ] open Pcaml @@ -176,38 +84,25 @@ EXTEND ] ] ; deprecation: - [ [ "DEPRECATED" -> () ] ] + [ [ -> false | "DEPRECATED" -> true ] ] ; - (* spiwack: comment-by-guessing: it seems that the isolated string - (which otherwise could have been another argument) is not passed - to the VernacExtend interpreter function to discriminate between - the clauses. *) rule: - [ [ "["; s = STRING; l = LIST0 args; "]"; - d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" -> - let () = if s = "" then failwith "Command name is empty." in - let b = <:expr< fun ~{atts} ~{st} -> ( let () = $e$ in st ) >> in - { r_head = Some s; r_patt = l; r_class = c; r_branch = b; r_depr = d; } - | "[" ; "-" ; l = LIST1 args ; "]" ; - d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" -> + [ [ "["; OPT "-"; l = LIST1 args; "]"; + d = deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" -> let b = <:expr< fun ~{atts} ~{st} -> ( let () = $e$ in st ) >> in - { r_head = None; r_patt = l; r_class = c; r_branch = b; r_depr = d; } + { r_patt = l; r_class = c; r_branch = b; r_depr = d; } ] ] ; + (** The [OPT "-"] argument serves no purpose nowadays, it is left here for + backward compatibility. *) fun_rule: - [ [ "["; s = STRING; l = LIST0 args; "]"; - d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" -> - let () = if s = "" then failwith "Command name is empty." in - let b = <:expr< $e$ >> in - { r_head = Some s; r_patt = l; r_class = c; r_branch = b; r_depr = d; } - | "[" ; "-" ; l = LIST1 args ; "]" ; - d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" -> - let b = <:expr< $e$ >> in - { r_head = None; r_patt = l; r_class = c; r_branch = b; r_depr = d; } + [ [ "["; OPT "-"; l = LIST1 args; "]"; + d = deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" -> + { r_patt = l; r_class = c; r_branch = e; r_depr = d; } ] ] ; classifier: - [ [ "=>"; "["; c = Pcaml.expr; "]" -> <:expr< fun loc -> $c$>> ] ] + [ [ "=>"; "["; c = Pcaml.expr; "]" -> <:expr< $c$>> ] ] ; args: [ [ e = LIDENT; "("; s = LIDENT; ")" -> diff --git a/ide/coq.ml b/ide/coq.ml index 63986935aa..e948360191 100644 --- a/ide/coq.ml +++ b/ide/coq.ml @@ -530,20 +530,31 @@ let break_coqtop coqtop workers = module PrintOpt = struct - type t = string list + type _ t = + | BoolOpt : string list -> bool t + | StringOpt : string list -> string t + + let opt_name (type a) : a t -> string list = function + | BoolOpt l -> l + | StringOpt l -> l + + let opt_data (type a) (key : a t) (v : a) = match key with + | BoolOpt l -> Interface.BoolValue v + | StringOpt l -> Interface.StringValue v (* Boolean options *) - let implicit = ["Printing"; "Implicit"] - let coercions = ["Printing"; "Coercions"] - let raw_matching = ["Printing"; "Matching"] - let notations = ["Printing"; "Notations"] - let all_basic = ["Printing"; "All"] - let existential = ["Printing"; "Existential"; "Instances"] - let universes = ["Printing"; "Universes"] - let unfocused = ["Printing"; "Unfocused"] + let implicit = BoolOpt ["Printing"; "Implicit"] + let coercions = BoolOpt ["Printing"; "Coercions"] + let raw_matching = BoolOpt ["Printing"; "Matching"] + let notations = BoolOpt ["Printing"; "Notations"] + let all_basic = BoolOpt ["Printing"; "All"] + let existential = BoolOpt ["Printing"; "Existential"; "Instances"] + let universes = BoolOpt ["Printing"; "Universes"] + let unfocused = BoolOpt ["Printing"; "Unfocused"] + let diff = StringOpt ["Diffs"] - type bool_descr = { opts : t list; init : bool; label : string } + type 'a descr = { opts : 'a t list; init : 'a; label : string } let bool_items = [ { opts = [implicit]; init = false; label = "Display _implicit arguments" }; @@ -561,24 +572,32 @@ struct { opts = [unfocused]; init = false; label = "Display _unfocused goals" } ] + let diff_item = { opts = [diff]; init = "off"; label = "Display _proof diffs" } + (** The current status of the boolean options *) let current_state = Hashtbl.create 11 - let set opt v = Hashtbl.replace current_state opt v + let set (type a) (opt : a t) (v : a) = + Hashtbl.replace current_state (opt_name opt) (opt_data opt v) let reset () = let init_descr d = List.iter (fun o -> set o d.init) d.opts in - List.iter init_descr bool_items + List.iter init_descr bool_items; + List.iter (fun o -> set o diff_item.init) diff_item.opts let _ = reset () - let printing_unfocused () = Hashtbl.find current_state unfocused + let printing_unfocused () = + let BoolOpt unfocused = unfocused in + match Hashtbl.find current_state unfocused with + | Interface.BoolValue b -> b + | _ -> assert false (** Transmitting options to coqtop *) let enforce h k = - let mkopt o v acc = (o, Interface.BoolValue v) :: acc in + let mkopt o v acc = (o, v) :: acc in let opts = Hashtbl.fold mkopt current_state [] in eval_call (Xmlprotocol.set_options opts) h (function diff --git a/ide/coq.mli b/ide/coq.mli index 40a6dea8d3..3af0aa697e 100644 --- a/ide/coq.mli +++ b/ide/coq.mli @@ -134,13 +134,15 @@ val stop_worker: Interface.stop_worker_sty-> Interface.stop_worker_rty query module PrintOpt : sig - type t (** Representation of an option *) + type 'a t (** Representation of an option *) - type bool_descr = { opts : t list; init : bool; label : string } + type 'a descr = { opts : 'a t list; init : 'a; label : string } - val bool_items : bool_descr list + val bool_items : bool descr list - val set : t -> bool -> unit + val diff_item : string descr + + val set : 'a t -> 'a -> unit val printing_unfocused: unit -> bool diff --git a/ide/coq_lex.mll b/ide/coq_lex.mll index 1fdd7317b5..b6654f6d7a 100644 --- a/ide/coq_lex.mll +++ b/ide/coq_lex.mll @@ -23,7 +23,11 @@ let number = [ '0'-'9' ]+ let string = "\"" _+ "\"" -let undotted_sep = (number space* ':' space*)? '{' | '}' | '-'+ | '+'+ | '*'+ +let alpha = ['a'-'z' 'A'-'Z'] + +let ident = alpha (alpha | number | '_' | "'")* + +let undotted_sep = ((number | '[' ident ']') space* ':' space*)? '{' | '}' | '-'+ | '+'+ | '*'+ let vernac_control = "Fail" | "Time" | "Redirect" space+ string | "Timeout" space+ number diff --git a/ide/coqide.ml b/ide/coqide.ml index aa816f2b8b..00d43e6e64 100644 --- a/ide/coqide.ml +++ b/ide/coqide.ml @@ -826,6 +826,7 @@ let refresh_notebook_pos () = let menu = GAction.add_actions let item = GAction.add_action +let radio = GAction.add_radio_action (** Toggle items in menus for printing options *) @@ -1043,7 +1044,27 @@ let build_ui () = ~callback:(fun _ -> show_toolbar#set (not show_toolbar#get)); item "Query Pane" ~label:"_Query Pane" ~accel:"F1" - ~callback:(cb_on_current_term MiscMenu.show_hide_query_pane) + ~callback:(cb_on_current_term MiscMenu.show_hide_query_pane); + GAction.group_radio_actions + ~init_value:( + let v = diffs#get in + List.iter (fun o -> Opt.set o v) Opt.diff_item.Opt.opts; + if v = "on" then 1 + else if v = "removed" then 2 + else 0) + ~callback:begin fun n -> + (match n with + | 0 -> List.iter (fun o -> Opt.set o "off"; diffs#set "off") Opt.diff_item.Opt.opts + | 1 -> List.iter (fun o -> Opt.set o "on"; diffs#set "on") Opt.diff_item.Opt.opts + | 2 -> List.iter (fun o -> Opt.set o "removed"; diffs#set "removed") Opt.diff_item.Opt.opts + | _ -> assert false); + send_to_coq (fun sn -> sn.coqops#show_goals) + end + [ + radio "Unset diff" 0 ~label:"_Don't show diffs"; + radio "Set diff" 1 ~label:"Show diffs: only _added"; + radio "Set removed diff" 2 ~label:"Show diffs: added and _removed"; + ]; ]; toggle_items view_menu Coq.PrintOpt.bool_items; @@ -1106,15 +1127,15 @@ let build_ui () = ]; alpha_items templates_menu "Template" Coq_commands.commands; - let qitem s sc ?(dots = true) = - let query = if dots then s ^ "..." else s in + let qitem s sc = + let query = s ^ "..." in item s ~label:("_"^s) ~accel:(modifier_for_queries#get^sc) ~callback:(Query.query query) in menu queries_menu [ item "Queries" ~label:"_Queries"; - qitem "Search" "K" ~dots:false; + qitem "Search" "K"; qitem "Check" "C"; qitem "Print" "P"; qitem "About" "A"; diff --git a/ide/coqide_ui.ml b/ide/coqide_ui.ml index 717c4000f5..91c529932f 100644 --- a/ide/coqide_ui.ml +++ b/ide/coqide_ui.ml @@ -86,6 +86,10 @@ let init () = \n <menuitem action='Display universe levels' />\ \n <menuitem action='Display all low-level contents' />\ \n <menuitem action='Display unfocused goals' />\ +\n <separator/>\ +\n <menuitem action='Unset diff' />\ +\n <menuitem action='Set diff' />\ +\n <menuitem action='Set removed diff' />\ \n </menu>\ \n <menu action='Navigation'>\ \n <menuitem action='Forward' />\ diff --git a/ide/idetop.ml b/ide/idetop.ml index 965bb913ff..d846b3abb5 100644 --- a/ide/idetop.ml +++ b/ide/idetop.ml @@ -53,10 +53,12 @@ let coqide_known_option table = List.mem table [ ["Printing";"Records"]; ["Printing";"Existential";"Instances"]; ["Printing";"Universes"]; - ["Printing";"Unfocused"]] + ["Printing";"Unfocused"]; + ["Diffs"]] let is_known_option cmd = match Vernacprop.under_control cmd with | VernacSetOption (_, o, BoolValue true) + | VernacSetOption (_, o, StringValue _) | VernacUnsetOption (_, o) -> coqide_known_option o | _ -> false @@ -211,15 +213,13 @@ let add_diffs oldp newp intf = { intf with fg_goals = { first_goal with goal_hyp = hyps_pp_list; goal_ccl = concl_pp } :: tl } let goals () = - let oldp = - try Some (Proof_global.give_me_the_proof ()) - with Proof_global.NoCurrentProof -> None in let doc = get_doc () in set_doc @@ Stm.finish ~doc; try let newp = Proof_global.give_me_the_proof () in let intf = export_pre_goals (Proof.map_structured_proof newp process_goal) in if Proof_diffs.show_diffs () then + let oldp = Stm.get_prev_proof ~doc (Stm.get_current_state ~doc) in try Some (add_diffs oldp (Some newp) intf) with Pp_diff.Diff_Failure _ -> Some intf @@ -530,9 +530,6 @@ let () = Usage.add_to_usage "coqidetop" let islave_init ~opts extra_args = let args = parse extra_args in CoqworkmgrApi.(init High); - let open Coqargs in - if not opts.diffs_set then - Proof_diffs.write_diffs_option "on"; opts, args let () = diff --git a/ide/preferences.ml b/ide/preferences.ml index 526d94a939..955ee87840 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -565,6 +565,9 @@ let nanoPG = let user_queries = new preference ~name:["user_queries"] ~init:[] ~repr:Repr.(string_pair_list '$') +let diffs = + new preference ~name:["diffs"] ~init:"off" ~repr:Repr.(string) + class tag_button (box : Gtk.box Gtk.obj) = object (self) diff --git a/ide/preferences.mli b/ide/preferences.mli index f3882d486d..dd2976efc2 100644 --- a/ide/preferences.mli +++ b/ide/preferences.mli @@ -102,6 +102,7 @@ val tab_length : int preference val highlight_current_line : bool preference val nanoPG : bool preference val user_queries : (string * string) list preference +val diffs : string preference val save_pref : unit -> unit val load_pref : unit -> unit diff --git a/interp/constrexpr.ml b/interp/constrexpr.ml index 521eeb8e96..d8dd4ef6dd 100644 --- a/interp/constrexpr.ml +++ b/interp/constrexpr.ml @@ -20,7 +20,10 @@ type universe_decl_expr = (lident list, Glob_term.glob_constraint list) UState.g type ident_decl = lident * universe_decl_expr option type name_decl = lname * universe_decl_expr option -type notation = string +type notation_entry = InConstrEntry | InCustomEntry of string +type notation_entry_level = InConstrEntrySomeLevel | InCustomEntryLevel of string * int +type notation_key = string +type notation = notation_entry_level * notation_key type 'a or_by_notation_r = | AN of 'a diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml index 4b1af9147c..011c4a6e4e 100644 --- a/interp/constrexpr_ops.ml +++ b/interp/constrexpr_ops.ml @@ -16,6 +16,7 @@ open Libnames open Namegen open Glob_term open Constrexpr +open Notation open Decl_kinds (***********************) @@ -80,7 +81,7 @@ let rec cases_pattern_expr_eq p1 p2 = | CPatOr a1, CPatOr a2 -> List.equal cases_pattern_expr_eq a1 a2 | CPatNotation (n1, s1, l1), CPatNotation (n2, s2, l2) -> - String.equal n1 n2 && + notation_eq n1 n2 && cases_pattern_notation_substitution_eq s1 s2 && List.equal cases_pattern_expr_eq l1 l2 | CPatPrim i1, CPatPrim i2 -> @@ -165,7 +166,7 @@ let rec constr_expr_eq e1 e2 = | CCast(t1,c1), CCast(t2,c2) -> constr_expr_eq t1 t2 && cast_expr_eq c1 c2 | CNotation(n1, s1), CNotation(n2, s2) -> - String.equal n1 n2 && + notation_eq n1 n2 && constr_notation_substitution_eq s1 s2 | CPrim i1, CPrim i2 -> prim_token_eq i1 i2 diff --git a/interp/constrexpr_ops.mli b/interp/constrexpr_ops.mli index 46aef1c788..61e8aa1b51 100644 --- a/interp/constrexpr_ops.mli +++ b/interp/constrexpr_ops.mli @@ -107,8 +107,8 @@ val occur_var_constr_expr : Id.t -> constr_expr -> bool val split_at_annot : local_binder_expr list -> lident option -> local_binder_expr list * local_binder_expr list -val ntn_loc : ?loc:Loc.t -> constr_notation_substitution -> string -> (int * int) list -val patntn_loc : ?loc:Loc.t -> cases_pattern_notation_substitution -> string -> (int * int) list +val ntn_loc : ?loc:Loc.t -> constr_notation_substitution -> notation -> (int * int) list +val patntn_loc : ?loc:Loc.t -> cases_pattern_notation_substitution -> notation -> (int * int) list (** For cases pattern parsing errors *) val error_invalid_pattern_notation : ?loc:Loc.t -> unit -> 'a diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 2538c77722..009894fddb 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -101,7 +101,7 @@ let _show_inactive_notations () = IRuleSet.iter (function | NotationRule (scopt, ntn) -> - Feedback.msg_notice (str ntn ++ show_scope scopt) + Feedback.msg_notice (pr_notation ntn ++ show_scope scopt) | SynDefRule kn -> Feedback.msg_notice (str (Names.KerName.to_string kn))) !inactive_notations_table @@ -113,14 +113,14 @@ let deactivate_notation nr = | NotationRule (scopt, ntn) -> match availability_of_notation (scopt, ntn) (scopt, []) with | None -> user_err ~hdr:"Notation" - (str ntn ++ spc () ++ str "does not exist" + (pr_notation ntn ++ spc () ++ str "does not exist" ++ (match scopt with | None -> spc () ++ str "in the empty scope." | Some _ -> show_scope scopt ++ str ".")) | Some _ -> if IRuleSet.mem nr !inactive_notations_table then Feedback.msg_warning - (str "Notation" ++ spc () ++ str ntn ++ spc () + (str "Notation" ++ spc () ++ pr_notation ntn ++ spc () ++ str "is already inactive" ++ show_scope scopt ++ str ".") else inactive_notations_table := IRuleSet.add nr !inactive_notations_table @@ -131,7 +131,7 @@ let reactivate_notation nr = with Not_found -> match nr with | NotationRule (scopt, ntn) -> - Feedback.msg_warning (str "Notation" ++ spc () ++ str ntn ++ spc () + Feedback.msg_warning (str "Notation" ++ spc () ++ pr_notation ntn ++ spc () ++ str "is already active" ++ show_scope scopt ++ str ".") | SynDefRule kn -> @@ -260,6 +260,14 @@ let insert_pat_alias ?loc p = function | Anonymous -> p | Name _ as na -> CAst.make ?loc @@ CPatAlias (p,(CAst.make ?loc na)) +let rec insert_coercion ?loc l c = match l with + | [] -> c + | ntn::l -> CAst.make ?loc @@ CNotation (ntn,([insert_coercion ?loc l c],[],[],[])) + +let rec insert_pat_coercion ?loc l c = match l with + | [] -> c + | ntn::l -> CAst.make ?loc @@ CPatNotation (ntn,([insert_pat_coercion ?loc l c],[]),[]) + (**********************************************************************) (* conversion of references *) @@ -325,16 +333,16 @@ let is_zero s = in aux 0 let make_notation_gen loc ntn mknot mkprim destprim l bl = - match ntn,List.map destprim l with + match snd ntn,List.map destprim l with (* Special case to avoid writing "- 3" for e.g. (Z.opp 3) *) | "- _", [Some (Numeral (p,true))] when not (is_zero p) -> assert (bl=[]); - mknot (loc,ntn,([mknot (loc,"( _ )",l,[])]),[]) + mknot (loc,ntn,([mknot (loc,(InConstrEntrySomeLevel,"( _ )"),l,[])]),[]) | _ -> match decompose_notation_key ntn, l with - | [Terminal "-"; Terminal x], [] when is_number x -> + | (InConstrEntrySomeLevel,[Terminal "-"; Terminal x]), [] when is_number x -> mkprim (loc, Numeral (x,false)) - | [Terminal x], [] when is_number x -> + | (InConstrEntrySomeLevel,[Terminal x]), [] when is_number x -> mkprim (loc, Numeral (x,true)) | _ -> mknot (loc,ntn,l,bl) @@ -367,31 +375,39 @@ let pattern_printable_in_both_syntax (ind,_ as c) = (List.for_all is_status_implicit params)&&(List.for_all (fun x -> not (is_status_implicit x)) args) ) impl_st -let lift f c = - let loc = c.CAst.loc in - CAst.make ?loc (f ?loc (DAst.get c)) - (* Better to use extern_glob_constr composed with injection/retraction ?? *) -let rec extern_cases_pattern_in_scope (scopes:local_scopes) vars pat = +let rec extern_cases_pattern_in_scope (custom,scopes as allscopes) vars pat = try if !Flags.in_debugger || !Flags.raw_print || !print_no_symbol then raise No_match; let (na,sc,p) = uninterp_prim_token_cases_pattern pat in + match availability_of_entry_coercion custom InConstrEntrySomeLevel with + | None -> raise No_match + | Some coercion -> match availability_of_prim_token p sc scopes with | None -> raise No_match | Some key -> let loc = cases_pattern_loc pat in - insert_pat_alias ?loc (insert_pat_delimiters ?loc (CAst.make ?loc @@ CPatPrim p) key) na + insert_pat_coercion ?loc coercion + (insert_pat_alias ?loc (insert_pat_delimiters ?loc (CAst.make ?loc @@ CPatPrim p) key) na) with No_match -> try if !Flags.in_debugger || !Flags.raw_print || !print_no_symbol then raise No_match; - extern_notation_pattern scopes vars pat + extern_notation_pattern allscopes vars pat (uninterp_cases_pattern_notations pat) with No_match -> - lift (fun ?loc -> function - | PatVar (Name id) -> CPatAtom (Some (qualid_of_ident ?loc id)) - | PatVar (Anonymous) -> CPatAtom None + let loc = pat.CAst.loc in + match DAst.get pat with + | PatVar (Name id) when entry_has_ident custom -> CAst.make ?loc (CPatAtom (Some (qualid_of_ident ?loc id))) + | pat -> + match availability_of_entry_coercion custom InConstrEntrySomeLevel with + | None -> raise No_match + | Some coercion -> + let allscopes = (InConstrEntrySomeLevel,scopes) in + let pat = match pat with + | PatVar (Name id) -> CAst.make ?loc (CPatAtom (Some (qualid_of_ident ?loc id))) + | PatVar (Anonymous) -> CAst.make ?loc (CPatAtom None) | PatCstr(cstrsp,args,na) -> - let args = List.map (extern_cases_pattern_in_scope scopes vars) args in + let args = List.map (extern_cases_pattern_in_scope allscopes vars) args in let p = try if !Flags.raw_print then raise Exit; @@ -424,26 +440,32 @@ let rec extern_cases_pattern_in_scope (scopes:local_scopes) vars pat = match drop_implicits_in_patt (ConstructRef cstrsp) 0 full_args with | Some true_args -> CPatCstr (c, None, true_args) | None -> CPatCstr (c, Some full_args, []) - in (insert_pat_alias ?loc (CAst.make ?loc p) na).v - ) pat + in + insert_pat_alias ?loc (CAst.make ?loc p) na + in + insert_pat_coercion coercion pat + and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args)) - (tmp_scope, scopes as allscopes) vars = + (custom, (tmp_scope, scopes) as allscopes) vars = function | NotationRule (sc,ntn) -> begin - match availability_of_notation (sc,ntn) allscopes with + match availability_of_entry_coercion custom (fst ntn) with + | None -> raise No_match + | Some coercion -> + match availability_of_notation (sc,ntn) (tmp_scope,scopes) with (* Uninterpretation is not allowed in current context *) | None -> raise No_match (* Uninterpretation is allowed in current context *) | Some (scopt,key) -> let scopes' = Option.List.cons scopt scopes in let l = - List.map (fun (c,(scopt,scl)) -> - extern_cases_pattern_in_scope (scopt,scl@scopes') vars c) + List.map (fun (c,(subentry,(scopt,scl))) -> + extern_cases_pattern_in_scope (subentry,(scopt,scl@scopes')) vars c) subst in let ll = - List.map (fun (c,(scopt,scl)) -> - let subscope = (scopt,scl@scopes') in + List.map (fun (c,(subentry,(scopt,scl))) -> + let subscope = (subentry,(scopt,scl@scopes')) in List.map (extern_cases_pattern_in_scope subscope vars) c) substlist in let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in @@ -453,14 +475,15 @@ and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args)) |Some true_args -> true_args |None -> raise No_match in - insert_pat_delimiters ?loc - (make_pat_notation ?loc ntn (l,ll) l2') key + insert_pat_coercion coercion + (insert_pat_delimiters ?loc + (make_pat_notation ?loc ntn (l,ll) l2') key) end | SynDefRule kn -> let qid = shortest_qualid_of_syndef ?loc vars kn in let l1 = - List.rev_map (fun (c,(scopt,scl)) -> - extern_cases_pattern_in_scope (scopt,scl@scopes) vars c) + List.rev_map (fun (c,(subentry,(scopt,scl))) -> + extern_cases_pattern_in_scope (subentry,(scopt,scl@scopes)) vars c) subst in let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in let l2' = if !asymmetric_patterns then l2 @@ -471,7 +494,7 @@ and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args)) in assert (List.is_empty substlist); mkPat ?loc qid (List.rev_append l1 l2') -and extern_notation_pattern (tmp_scope,scopes as allscopes) vars t = function +and extern_notation_pattern allscopes vars t = function | [] -> raise No_match | (keyrule,pat,n as _rule)::rules -> try @@ -498,35 +521,38 @@ let rec extern_notation_ind_pattern allscopes vars ind args = function with No_match -> extern_notation_ind_pattern allscopes vars ind args rules -let extern_ind_pattern_in_scope (scopes:local_scopes) vars ind args = +let extern_ind_pattern_in_scope (custom,scopes as allscopes) vars ind args = (* pboutill: There are letins in pat which is incompatible with notations and not explicit application. *) if !Flags.in_debugger||Inductiveops.inductive_has_local_defs ind then let c = extern_reference vars (IndRef ind) in - let args = List.map (extern_cases_pattern_in_scope scopes vars) args in + let args = List.map (extern_cases_pattern_in_scope allscopes vars) args in CAst.make @@ CPatCstr (c, Some (add_patt_for_params ind args), []) else try if !Flags.raw_print || !print_no_symbol then raise No_match; let (sc,p) = uninterp_prim_token_ind_pattern ind args in + match availability_of_entry_coercion custom InConstrEntrySomeLevel with + | None -> raise No_match + | Some coercion -> match availability_of_prim_token p sc scopes with | None -> raise No_match | Some key -> - insert_pat_delimiters (CAst.make @@ CPatPrim p) key + insert_pat_coercion coercion (insert_pat_delimiters (CAst.make @@ CPatPrim p) key) with No_match -> try if !Flags.raw_print || !print_no_symbol then raise No_match; - extern_notation_ind_pattern scopes vars ind args + extern_notation_ind_pattern allscopes vars ind args (uninterp_ind_pattern_notations ind) with No_match -> let c = extern_reference vars (IndRef ind) in - let args = List.map (extern_cases_pattern_in_scope scopes vars) args in + let args = List.map (extern_cases_pattern_in_scope allscopes vars) args in match drop_implicits_in_patt (IndRef ind) 0 args with |Some true_args -> CAst.make @@ CPatCstr (c, None, true_args) |None -> CAst.make @@ CPatCstr (c, Some args, []) let extern_cases_pattern vars p = - extern_cases_pattern_in_scope (None,[]) vars p + extern_cases_pattern_in_scope (InConstrEntrySomeLevel,(None,[])) vars p (**********************************************************************) (* Externalising applications *) @@ -640,12 +666,12 @@ let extern_app inctx impl (cf,f) us args = else explicitize inctx impl (cf, CAst.make @@ CRef (f,us)) args -let rec fill_arg_scopes args subscopes scopes = match args, subscopes with +let rec fill_arg_scopes args subscopes (entry,(_,scopes) as all) = match args, subscopes with | [], _ -> [] | a :: args, scopt :: subscopes -> - (a, (scopt, scopes)) :: fill_arg_scopes args subscopes scopes + (a, (entry, (scopt, scopes))) :: fill_arg_scopes args subscopes all | a :: args, [] -> - (a, (None, scopes)) :: fill_arg_scopes args [] scopes + (a, (entry, (None, scopes))) :: fill_arg_scopes args [] all let extern_args extern env args = let map (arg, argscopes) = lazy (extern argscopes env arg) in @@ -697,12 +723,15 @@ let rec flatten_application c = match DAst.get c with (* mapping glob_constr to numerals (in presence of coercions, choose the *) (* one with no delimiter if possible) *) -let extern_possible_prim_token scopes r = +let extern_possible_prim_token (custom,scopes) r = try let (sc,n) = uninterp_prim_token r in + match availability_of_entry_coercion custom InConstrEntrySomeLevel with + | None -> raise No_match + | Some coercion -> match availability_of_prim_token n sc scopes with | None -> None - | Some key -> Some (insert_delimiters (CAst.make ?loc:(loc_of_glob_constr r) @@ CPrim n) key) + | Some key -> Some (insert_coercion coercion (insert_delimiters (CAst.make ?loc:(loc_of_glob_constr r) @@ CPrim n) key)) with No_match -> None @@ -737,7 +766,13 @@ let extern_glob_sort = function let extern_universes = function | Some _ as l when !print_universes -> l | _ -> None - + +let extern_ref vars ref us = + extern_global (select_stronger_impargs (implicits_of_global ref)) + (extern_reference vars ref) (extern_universes us) + +let extern_var ?loc id = CRef (qualid_of_ident ?loc id,None) + let rec extern inctx scopes vars r = let r' = remove_coercions inctx r in try @@ -748,12 +783,27 @@ let rec extern inctx scopes vars r = let r'' = flatten_application r' in if !Flags.raw_print || !print_no_symbol then raise No_match; extern_notation scopes vars r'' (uninterp_notations r'') - with No_match -> lift (fun ?loc -> function - | GRef (ref,us) -> - extern_global (select_stronger_impargs (implicits_of_global ref)) - (extern_reference vars ref) (extern_universes us) + with No_match -> + let loc = r'.CAst.loc in + match DAst.get r' with + | GRef (ref,us) when entry_has_global (fst scopes) -> CAst.make ?loc (extern_ref vars ref us) + + | GVar id when entry_has_ident (fst scopes) -> CAst.make ?loc (extern_var ?loc id) + + | c -> + + match availability_of_entry_coercion (fst scopes) InConstrEntrySomeLevel with + | None -> raise No_match + | Some coercion -> - | GVar id -> CRef (qualid_of_ident ?loc id,None) + let scopes = (InConstrEntrySomeLevel, snd scopes) in + let c = match c with + + (* The remaining cases are only for the constr entry *) + + | GRef (ref,us) -> extern_ref vars ref us + + | GVar id -> extern_var ?loc id | GEvar (n,[]) when !print_meta_as_hole -> CHole (None, IntroAnonymous, None) @@ -770,7 +820,7 @@ let rec extern inctx scopes vars r = (match DAst.get f with | GRef (ref,us) -> let subscopes = find_arguments_scope ref in - let args = fill_arg_scopes args subscopes (snd scopes) in + let args = fill_arg_scopes args subscopes scopes in begin try if !Flags.raw_print then raise Exit; @@ -921,12 +971,13 @@ let rec extern inctx scopes vars r = | GProj (p, c) -> let pr = extern_reference ?loc Id.Set.empty (ConstRef (Projection.constant p)) in CProj (pr, sub_extern inctx scopes vars c) - ) r' -and extern_typ (_,scopes) = - extern true (Notation.current_type_scope_name (),scopes) + in insert_coercion coercion (CAst.make ?loc c) + +and extern_typ (subentry,(_,scopes)) = + extern true (subentry,(Notation.current_type_scope_name (),scopes)) -and sub_extern inctx (_,scopes) = extern inctx (None,scopes) +and sub_extern inctx (subentry,(_,scopes)) = extern inctx (subentry,(None,scopes)) and factorize_prod scopes vars na bk aty c = let store, get = set_temporary_memory () in @@ -1019,7 +1070,7 @@ and extern_eqn inctx scopes vars {CAst.loc;v=(ids,pll,c)} = let pll = List.map (List.map (extern_cases_pattern_in_scope scopes vars)) pll in make ?loc (pll,extern inctx scopes vars c) -and extern_notation (tmp_scope,scopes as allscopes) vars t = function +and extern_notation (custom,scopes as allscopes) vars t = function | [] -> raise No_match | (keyrule,pat,n as _rule)::rules -> let loc = Glob_ops.loc_of_glob_constr t in @@ -1066,40 +1117,43 @@ and extern_notation (tmp_scope,scopes as allscopes) vars t = function let e = match keyrule with | NotationRule (sc,ntn) -> - (match availability_of_notation (sc,ntn) allscopes with + (match availability_of_entry_coercion custom (fst ntn) with + | None -> raise No_match + | Some coercion -> + match availability_of_notation (sc,ntn) scopes with (* Uninterpretation is not allowed in current context *) | None -> raise No_match (* Uninterpretation is allowed in current context *) | Some (scopt,key) -> - let scopes' = Option.List.cons scopt scopes in + let scopes' = Option.List.cons scopt (snd scopes) in let l = - List.map (fun (c,(scopt,scl)) -> + List.map (fun (c,(subentry,(scopt,scl))) -> extern (* assuming no overloading: *) true - (scopt,scl@scopes') vars c) + (subentry,(scopt,scl@scopes')) vars c) terms in let ll = - List.map (fun (c,(scopt,scl)) -> - List.map (extern true (scopt,scl@scopes') vars) c) + List.map (fun (c,(subentry,(scopt,scl))) -> + List.map (extern true (subentry,(scopt,scl@scopes')) vars) c) termlists in let bl = - List.map (fun (bl,(scopt,scl)) -> - mkCPatOr (List.map (extern_cases_pattern_in_scope (scopt,scl@scopes') vars) bl)) + List.map (fun (bl,(subentry,(scopt,scl))) -> + mkCPatOr (List.map (extern_cases_pattern_in_scope (subentry,(scopt,scl@scopes')) vars) bl)) binders in let bll = - List.map (fun (bl,(scopt,scl)) -> - pi3 (extern_local_binder (scopt,scl@scopes') vars bl)) + List.map (fun (bl,(subentry,(scopt,scl))) -> + pi3 (extern_local_binder (subentry,(scopt,scl@scopes')) vars bl)) binderlists in - insert_delimiters (make_notation loc ntn (l,ll,bl,bll)) key) + insert_coercion coercion (insert_delimiters (make_notation loc ntn (l,ll,bl,bll)) key)) | SynDefRule kn -> let l = - List.map (fun (c,(scopt,scl)) -> - extern true (scopt,scl@scopes) vars c, None) + List.map (fun (c,(subentry,(scopt,scl))) -> + extern true (subentry,(scopt,scl@snd scopes)) vars c, None) terms in let a = CRef (shortest_qualid_of_syndef ?loc vars kn,None) in CAst.make ?loc @@ if List.is_empty l then a else CApp ((None, CAst.make a),l) in if List.is_empty args then e else - let args = fill_arg_scopes args argsscopes scopes in + let args = fill_arg_scopes args argsscopes allscopes in let args = extern_args (extern true) vars args in CAst.make ?loc @@ explicitize false argsimpls (None,e) args with @@ -1113,10 +1167,10 @@ and extern_recursion_order scopes vars = function let extern_glob_constr vars c = - extern false (None,[]) vars c + extern false (InConstrEntrySomeLevel,(None,[])) vars c let extern_glob_type vars c = - extern_typ (None,[]) vars c + extern_typ (InConstrEntrySomeLevel,(None,[])) vars c (******************************************************************) (* Main translation function from constr -> constr_expr *) @@ -1132,7 +1186,7 @@ let extern_constr_gen lax goal_concl_style scopt env sigma t = let avoid = if goal_concl_style then vars_of_env env else Id.Set.empty in let r = Detyping.detype Detyping.Later ~lax:lax goal_concl_style avoid env sigma t in let vars = vars_of_env env in - extern false (scopt,[]) vars r + extern false (InConstrEntrySomeLevel,(scopt,[])) vars r let extern_constr_in_scope goal_concl_style scope env sigma t = extern_constr_gen false goal_concl_style (Some scope) env sigma t @@ -1153,7 +1207,7 @@ let extern_closed_glob ?lax goal_concl_style env sigma t = Detyping.detype_closed_glob ?lax goal_concl_style avoid env sigma t in let vars = vars_of_env env in - extern false (None,[]) vars r + extern false (InConstrEntrySomeLevel,(None,[])) vars r (******************************************************************) (* Main translation function from pattern -> constr_expr *) @@ -1262,10 +1316,10 @@ let rec glob_of_pat avoid env sigma pat = DAst.make @@ match pat with | PSort s -> GSort s let extern_constr_pattern env sigma pat = - extern true (None,[]) Id.Set.empty (glob_of_pat Id.Set.empty env sigma pat) + extern true (InConstrEntrySomeLevel,(None,[])) Id.Set.empty (glob_of_pat Id.Set.empty env sigma pat) let extern_rel_context where env sigma sign = let a = detype_rel_context Detyping.Later where Id.Set.empty (names_of_rel_context env,env) sigma sign in let vars = vars_of_env env in let a = List.map (extended_glob_local_binder_of_decl) a in - pi3 (extern_local_binder (None,[]) vars a) + pi3 (extern_local_binder (InConstrEntrySomeLevel,(None,[])) vars a) diff --git a/interp/constrintern.ml b/interp/constrintern.ml index c87768b190..1c8d957014 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -218,30 +218,36 @@ let expand_notation_string ntn n = (* This contracts the special case of "{ _ }" for sumbool, sumor notations *) (* Remark: expansion of squash at definition is done in metasyntax.ml *) let contract_curly_brackets ntn (l,ll,bl,bll) = + match ntn with + | InCustomEntryLevel _,_ -> ntn,(l,ll,bl,bll) + | InConstrEntrySomeLevel, ntn -> let ntn' = ref ntn in let rec contract_squash n = function | [] -> [] - | { CAst.v = CNotation ("{ _ }",([a],[],[],[])) } :: l -> + | { CAst.v = CNotation ((InConstrEntrySomeLevel,"{ _ }"),([a],[],[],[])) } :: l -> ntn' := expand_notation_string !ntn' n; contract_squash n (a::l) | a :: l -> a::contract_squash (n+1) l in let l = contract_squash 0 l in (* side effect; don't inline *) - !ntn',(l,ll,bl,bll) + (InConstrEntrySomeLevel,!ntn'),(l,ll,bl,bll) let contract_curly_brackets_pat ntn (l,ll) = + match ntn with + | InCustomEntryLevel _,_ -> ntn,(l,ll) + | InConstrEntrySomeLevel, ntn -> let ntn' = ref ntn in let rec contract_squash n = function | [] -> [] - | { CAst.v = CPatNotation ("{ _ }",([a],[]),[]) } :: l -> + | { CAst.v = CPatNotation ((InConstrEntrySomeLevel,"{ _ }"),([a],[]),[]) } :: l -> ntn' := expand_notation_string !ntn' n; contract_squash n (a::l) | a :: l -> a::contract_squash (n+1) l in let l = contract_squash 0 l in (* side effect; don't inline *) - !ntn',(l,ll) + (InConstrEntrySomeLevel,!ntn'),(l,ll) type intern_env = { ids: Names.Id.Set.t; @@ -819,7 +825,7 @@ let split_by_type ids subst = | [] -> assert false | a::l -> l, Id.Map.add id (a,scl) s in let (terms,termlists,binders,binderlists),subst = - List.fold_left (fun ((terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')) (id,(scl,typ)) -> + List.fold_left (fun ((terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')) (id,((_,scl),typ)) -> match typ with | NtnTypeConstr -> let terms,terms' = bind id scl terms terms' in @@ -847,10 +853,10 @@ let split_by_type ids subst = subst let split_by_type_pat ?loc ids subst = - let bind id scl l s = + let bind id (_,scopes) l s = match l with | [] -> assert false - | a::l -> l, Id.Map.add id (a,scl) s in + | a::l -> l, Id.Map.add id (a,scopes) s in let (terms,termlists),subst = List.fold_left (fun ((terms,termlists),(terms',termlists')) (id,(scl,typ)) -> match typ with @@ -866,7 +872,7 @@ let split_by_type_pat ?loc ids subst = subst let make_subst ids l = - let fold accu (id, scl) a = Id.Map.add id (a, scl) accu in + let fold accu (id, scopes) a = Id.Map.add id (a, scopes) accu in List.fold_left2 fold Id.Map.empty ids l let intern_notation intern env ntnvars loc ntn fullargs = @@ -1555,11 +1561,11 @@ let drop_notations_pattern looked_for genv = (* but not scopes in expl_pl *) let (argscs1,_) = find_remaining_scopes expl_pl pl g in DAst.make ?loc @@ RCPatCstr (g, List.map2 (in_pat_sc scopes) argscs1 expl_pl @ List.map (in_pat false scopes) pl, []) - | CPatNotation ("- _",([a],[]),[]) when is_non_zero_pat a -> + | CPatNotation ((InConstrEntrySomeLevel,"- _"),([a],[]),[]) when is_non_zero_pat a -> let p = match a.CAst.v with CPatPrim (Numeral (p, _)) -> p | _ -> assert false in let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc (ensure_kind false loc) (Numeral (p,false)) scopes in rcp_of_glob scopes pat - | CPatNotation ("( _ )",([a],[]),[]) -> + | CPatNotation ((InConstrEntrySomeLevel,"( _ )"),([a],[]),[]) -> in_pat top scopes a | CPatNotation (ntn,fullargs,extrargs) -> let ntn,(terms,termlists) = contract_curly_brackets_pat ntn fullargs in @@ -1872,10 +1878,10 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = DAst.make ?loc @@ GLetIn (na.CAst.v, inc1, int, intern (push_name_env ntnvars (impls_term_list inc1) env na) c2) - | CNotation ("- _", ([a],[],[],[])) when is_non_zero a -> + | CNotation ((InConstrEntrySomeLevel,"- _"), ([a],[],[],[])) when is_non_zero a -> let p = match a.CAst.v with CPrim (Numeral (p, _)) -> p | _ -> assert false in intern env (CAst.make ?loc @@ CPrim (Numeral (p,false))) - | CNotation ("( _ )",([a],[],[],[])) -> intern env a + | CNotation ((InConstrEntrySomeLevel,"( _ )"),([a],[],[],[])) -> intern env a | CNotation (ntn,args) -> intern_notation intern env ntnvars loc ntn args | CGeneralization (b,a,c) -> @@ -1891,9 +1897,9 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = intern_applied_reference intern env (Environ.named_context globalenv) lvar us args ref in - (* Rem: GApp(_,f,[]) stands for @f *) - DAst.make ?loc @@ - GApp (f, intern_args env args_scopes (List.map fst args)) + (* Rem: GApp(_,f,[]) stands for @f *) + if args = [] then DAst.make ?loc @@ GApp (f,[]) else + smart_gapp f loc (intern_args env args_scopes (List.map fst args)) | CApp ((isproj,f), args) -> let f,args = match f.CAst.v with diff --git a/interp/declare.ml b/interp/declare.ml index 0222aeb283..2b2ca36edc 100644 --- a/interp/declare.ml +++ b/interp/declare.ml @@ -471,24 +471,20 @@ let assumption_message id = discussion on coqdev: "Chapter 4 of the Reference Manual", 8/10/2015) *) Flags.if_verbose Feedback.msg_info (Id.print id ++ str " is declared") -(** Global universe names, in a different summary *) +(** Monomorphic universes need to survive sections. *) -type universe_context_decl = polymorphic * Univ.ContextSet.t - -let cache_universe_context (p, ctx) = - Global.push_context_set p ctx; - if p then Lib.add_section_context ctx - -let input_universe_context : universe_context_decl -> Libobject.obj = +let input_universe_context : Univ.ContextSet.t -> Libobject.obj = declare_object - { (default_object "Global universe context state") with - cache_function = (fun (na, pi) -> cache_universe_context pi); - load_function = (fun _ (_, pi) -> cache_universe_context pi); - discharge_function = (fun (_, (p, _ as x)) -> if p then None else Some x); - classify_function = (fun a -> Keep a) } + { (default_object "Monomorphic section universes") with + cache_function = (fun (na, uctx) -> Global.push_context_set false uctx); + discharge_function = (fun (_, x) -> Some x); + classify_function = (fun a -> Dispose) } let declare_universe_context poly ctx = - Lib.add_anonymous_leaf (input_universe_context (poly, ctx)) + if poly then + (Global.push_context_set true ctx; Lib.add_section_context ctx) + else + Lib.add_anonymous_leaf (input_universe_context ctx) (** Global universes are not substitutive objects but global objects bound at the *library* or *module* level. The polymorphic flag is @@ -597,27 +593,8 @@ let do_universe poly l = ignore(Lib.add_leaf id (input_universe (src, lev)))) l -type constraint_decl = polymorphic * Univ.Constraint.t - -let cache_constraints (na, (p, c)) = - let ctx = - Univ.ContextSet.add_constraints c - Univ.ContextSet.empty (* No declared universes here, just constraints *) - in cache_universe_context (p,ctx) - -let discharge_constraints (_, (p, c as a)) = - if p then None else Some a - -let input_constraints : constraint_decl -> Libobject.obj = - let open Libobject in - declare_object - { (default_object "Global universe constraints") with - cache_function = cache_constraints; - load_function = (fun _ -> cache_constraints); - discharge_function = discharge_constraints; - classify_function = (fun a -> Keep a) } - let do_constraint poly l = + let open Univ in let u_of_id x = let level = Pretyping.interp_known_glob_level (Evd.from_env (Global.env ())) x in UnivNames.is_polymorphic level, level @@ -639,7 +616,8 @@ let do_constraint poly l = let constraints = List.fold_left (fun acc (l, d, r) -> let p, lu = u_of_id l and p', ru = u_of_id r in check_poly p p'; - Univ.Constraint.add (lu, d, ru) acc) - Univ.Constraint.empty l + Constraint.add (lu, d, ru) acc) + Constraint.empty l in - Lib.add_anonymous_leaf (input_constraints (poly, constraints)) + let uctx = ContextSet.add_constraints constraints ContextSet.empty in + declare_universe_context poly uctx diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml index 5bf46282fd..ccad6b19eb 100644 --- a/interp/dumpglob.ml +++ b/interp/dumpglob.ml @@ -167,7 +167,7 @@ let dump_modref ?loc mp ty = let dump_libref ?loc dp ty = dump_ref ?loc (Names.DirPath.to_string dp) "<>" "<>" ty -let cook_notation df sc = +let cook_notation (from,df) sc = (* We encode notations so that they are space-free and still human-readable *) (* - all spaces are replaced by _ *) (* - all _ denoting a non-terminal symbol are replaced by x *) @@ -203,7 +203,9 @@ let cook_notation df sc = if !i <= l then (set ntn !j '_'; incr j; incr i) done; let df = Bytes.sub_string ntn 0 !j in - match sc with Some sc -> ":" ^ sc ^ ":" ^ df | _ -> "::" ^ df + let df_sc = match sc with Some sc -> ":" ^ sc ^ ":" ^ df | _ -> "::" ^ df in + let from_df_sc = match from with Constrexpr.InCustomEntryLevel (from,_) -> ":" ^ from ^ df_sc | Constrexpr.InConstrEntrySomeLevel -> ":" ^ df_sc in + from_df_sc let dump_notation_location posl df (((path,secpath),_),sc) = if dump () then diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml index 288a0bfe00..4f3037b1fc 100644 --- a/interp/implicit_quantifiers.ml +++ b/interp/implicit_quantifiers.ml @@ -98,7 +98,7 @@ let free_vars_of_constr_expr c ?(bound=Id.Set.empty) l = let rec aux bdvars l c = match CAst.(c.v) with | CRef (qid,_) when qualid_is_ident qid -> found c.CAst.loc (qualid_basename qid) bdvars l - | CNotation ("{ _ : _ | _ }", ({ CAst.v = CRef (qid,_) } :: _, [], [], [])) when + | CNotation ((InConstrEntrySomeLevel,"{ _ : _ | _ }"), ({ CAst.v = CRef (qid,_) } :: _, [], [], [])) when qualid_is_ident qid && not (Id.Set.mem (qualid_basename qid) bdvars) -> Constrexpr_ops.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux (Id.Set.add (qualid_basename qid) bdvars) l c | _ -> Constrexpr_ops.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux bdvars l c diff --git a/interp/notation.ml b/interp/notation.ml index 05fcd0e7f5..625d072b9f 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -39,6 +39,30 @@ open Context.Named.Declaration expression, set this scope to be the current scope *) +let notation_entry_eq s1 s2 = match (s1,s2) with +| InConstrEntry, InConstrEntry -> true +| InCustomEntry s1, InCustomEntry s2 -> String.equal s1 s2 +| (InConstrEntry | InCustomEntry _), _ -> false + +let notation_entry_level_eq s1 s2 = match (s1,s2) with +| InConstrEntrySomeLevel, InConstrEntrySomeLevel -> true +| InCustomEntryLevel (s1,n1), InCustomEntryLevel (s2,n2) -> String.equal s1 s2 && n1 = n2 +| (InConstrEntrySomeLevel | InCustomEntryLevel _), _ -> false + +let notation_eq (from1,ntn1) (from2,ntn2) = + notation_entry_level_eq from1 from2 && String.equal ntn1 ntn2 + +let pr_notation (from,ntn) = qstring ntn ++ match from with InConstrEntrySomeLevel -> mt () | InCustomEntryLevel (s,n) -> str " in custom " ++ str s + +module NotationOrd = + struct + type t = notation + let compare = Pervasives.compare + end + +module NotationSet = Set.Make(NotationOrd) +module NotationMap = CMap.Make(NotationOrd) + (**********************************************************************) (* Scope of symbols *) @@ -51,7 +75,7 @@ type notation_data = { } type scope = { - notations: notation_data String.Map.t; + notations: notation_data NotationMap.t; delimiters: delimiters option } @@ -62,7 +86,7 @@ let scope_map = ref String.Map.empty let delimiters_map = ref String.Map.empty let empty_scope = { - notations = String.Map.empty; + notations = NotationMap.empty; delimiters = None } @@ -71,6 +95,9 @@ let default_scope = "" (* empty name, not available from outside *) let init_scope_map () = scope_map := String.Map.add default_scope empty_scope !scope_map +(**********************************************************************) +(* Operations on scopes *) + let declare_scope scope = try let _ = String.Map.find scope !scope_map in () with Not_found -> @@ -101,12 +128,12 @@ let normalize_scope sc = (**********************************************************************) (* The global stack of scopes *) -type scope_elem = Scope of scope_name | SingleNotation of string +type scope_elem = Scope of scope_name | SingleNotation of notation type scopes = scope_elem list let scope_eq s1 s2 = match s1, s2 with -| Scope s1, Scope s2 -| SingleNotation s1, SingleNotation s2 -> String.equal s1 s2 +| Scope s1, Scope s2 -> String.equal s1 s2 +| SingleNotation s1, SingleNotation s2 -> notation_eq s1 s2 | Scope _, SingleNotation _ | SingleNotation _, Scope _ -> false @@ -158,8 +185,6 @@ let push_scope sc scopes = Scope sc :: scopes let push_scopes = List.fold_right push_scope -type local_scopes = tmp_scope_name option * scope_name list - let make_current_scopes (tmp_scope,scopes) = Option.fold_right push_scope tmp_scope (push_scopes scopes !scope_stack) @@ -376,7 +401,7 @@ let rec find_without_delimiters find (ntn_scope,ntn) = function end | SingleNotation ntn' :: scopes -> begin match ntn_scope, ntn with - | None, Some ntn when String.equal ntn ntn' -> + | None, Some ntn when notation_eq ntn ntn' -> Some (None, None) | _ -> find_without_delimiters find (ntn_scope,ntn) scopes @@ -390,7 +415,7 @@ let rec find_without_delimiters find (ntn_scope,ntn) = function let warn_notation_overridden = CWarnings.create ~name:"notation-overridden" ~category:"parsing" (fun (ntn,which_scope) -> - str "Notation" ++ spc () ++ str ntn ++ spc () + str "Notation" ++ spc () ++ pr_notation ntn ++ spc () ++ strbrk "was already used" ++ which_scope ++ str ".") let declare_notation_interpretation ntn scopt pat df ~onlyprint = @@ -398,7 +423,7 @@ let declare_notation_interpretation ntn scopt pat df ~onlyprint = let sc = find_scope scope in if not onlyprint then begin let () = - if String.Map.mem ntn sc.notations then + if NotationMap.mem ntn sc.notations then let which_scope = match scopt with | None -> mt () | Some _ -> spc () ++ strbrk "in scope" ++ spc () ++ str scope in @@ -408,7 +433,7 @@ let declare_notation_interpretation ntn scopt pat df ~onlyprint = not_interp = pat; not_location = df; } in - let sc = { sc with notations = String.Map.add ntn notdata sc.notations } in + let sc = { sc with notations = NotationMap.add ntn notdata sc.notations } in scope_map := String.Map.add scope sc !scope_map end; begin match scopt with @@ -425,7 +450,7 @@ let rec find_interpretation ntn find = function | Scope scope :: scopes -> (try let (pat,df) = find scope in pat,(df,Some scope) with Not_found -> find_interpretation ntn find scopes) - | SingleNotation ntn'::scopes when String.equal ntn' ntn -> + | SingleNotation ntn'::scopes when notation_eq ntn' ntn -> (try let (pat,df) = find default_scope in pat,(df,None) with Not_found -> (* e.g. because single notation only for constr, not cases_pattern *) @@ -434,12 +459,12 @@ let rec find_interpretation ntn find = function find_interpretation ntn find scopes let find_notation ntn sc = - let n = String.Map.find ntn (find_scope sc).notations in + let n = NotationMap.find ntn (find_scope sc).notations in (n.not_interp, n.not_location) let notation_of_prim_token = function - | Numeral (n,true) -> n - | Numeral (n,false) -> "- "^n + | Numeral (n,true) -> InConstrEntrySomeLevel, n + | Numeral (n,false) -> InConstrEntrySomeLevel, "- "^n | String _ -> raise Not_found let find_prim_token check_allowed ?loc p sc = @@ -459,13 +484,13 @@ let find_prim_token check_allowed ?loc p sc = let interp_prim_token_gen ?loc g p local_scopes = let scopes = make_current_scopes local_scopes in - let p_as_ntn = try notation_of_prim_token p with Not_found -> "" in + let p_as_ntn = try notation_of_prim_token p with Not_found -> InConstrEntrySomeLevel,"" in try find_interpretation p_as_ntn (find_prim_token ?loc g p) scopes with Not_found -> user_err ?loc ~hdr:"interp_prim_token" ((match p with | Numeral _ -> - str "No interpretation for numeral " ++ str (notation_of_prim_token p) + str "No interpretation for numeral " ++ pr_notation (notation_of_prim_token p) | String s -> str "No interpretation for string " ++ qs s) ++ str ".") let interp_prim_token ?loc = @@ -490,7 +515,7 @@ let interp_notation ?loc ntn local_scopes = try find_interpretation ntn (find_notation ntn) scopes with Not_found -> user_err ?loc - (str "Unknown interpretation for notation \"" ++ str ntn ++ str "\".") + (str "Unknown interpretation for notation " ++ pr_notation ntn ++ str ".") let uninterp_notations c = List.map_append (fun key -> keymap_find key !notations_key_table) @@ -504,9 +529,125 @@ let uninterp_ind_pattern_notations ind = let availability_of_notation (ntn_scope,ntn) scopes = let f scope = - String.Map.mem ntn (String.Map.find scope !scope_map).notations in + NotationMap.mem ntn (String.Map.find scope !scope_map).notations in find_without_delimiters f (ntn_scope,Some ntn) (make_current_scopes scopes) +(* We support coercions from a custom entry at some level to an entry + at some level (possibly the same), and from and to the constr entry. E.g.: + + Notation "[ expr ]" := expr (expr custom group at level 1). + Notation "( x )" := x (in custom group at level 0, x at level 1). + Notation "{ x }" := x (in custom group at level 0, x constr). + + Supporting any level is maybe overkill in that coercions are + commonly from the lowest level of the source entry to the highest + level of the target entry. *) + +type entry_coercion = notation list + +module EntryCoercionOrd = + struct + type t = notation_entry * notation_entry + let compare = Pervasives.compare + end + +module EntryCoercionMap = Map.Make(EntryCoercionOrd) + +let entry_coercion_map = ref EntryCoercionMap.empty + +let level_ord lev lev' = + match lev, lev' with + | None, _ -> true + | _, None -> true + | Some n, Some n' -> n <= n' + +let rec search nfrom nto = function + | [] -> raise Not_found + | ((pfrom,pto),coe)::l -> + if level_ord pfrom nfrom && level_ord nto pto then coe else search nfrom nto l + +let decompose_custom_entry = function + | InConstrEntrySomeLevel -> InConstrEntry, None + | InCustomEntryLevel (s,n) -> InCustomEntry s, Some n + +let availability_of_entry_coercion entry entry' = + let entry, lev = decompose_custom_entry entry in + let entry', lev' = decompose_custom_entry entry' in + if notation_entry_eq entry entry' && level_ord lev' lev then Some [] + else + try Some (search lev lev' (EntryCoercionMap.find (entry,entry') !entry_coercion_map)) + with Not_found -> None + +let better_path ((lev1,lev2),path) ((lev1',lev2'),path') = + (* better = shorter and lower source and higher target *) + level_ord lev1 lev1' && level_ord lev2' lev2 && List.length path <= List.length path' + +let shorter_path (_,path) (_,path') = + List.length path <= List.length path' + +let rec insert_coercion_path path = function + | [] -> [path] + | path'::paths as allpaths -> + (* If better or equal we keep the more recent one *) + if better_path path path' then path::paths + else if better_path path' path then allpaths + else if shorter_path path path' then path::allpaths + else path'::insert_coercion_path path paths + +let declare_entry_coercion (entry,_ as ntn) entry' = + let entry, lev = decompose_custom_entry entry in + let entry', lev' = decompose_custom_entry entry' in + (* Transitive closure *) + let toaddleft = + EntryCoercionMap.fold (fun (entry'',entry''') paths l -> + List.fold_right (fun ((lev'',lev'''),path) l -> + if notation_entry_eq entry entry''' && level_ord lev lev''' && + not (notation_entry_eq entry' entry'') + then ((entry'',entry'),((lev'',lev'),path@[ntn]))::l else l) paths l) + !entry_coercion_map [] in + let toaddright = + EntryCoercionMap.fold (fun (entry'',entry''') paths l -> + List.fold_right (fun ((lev'',lev'''),path) l -> + if entry' = entry'' && level_ord lev' lev'' && entry <> entry''' + then ((entry,entry'''),((lev,lev'''),path@[ntn]))::l else l) paths l) + !entry_coercion_map [] in + entry_coercion_map := + List.fold_right (fun (pair,path) -> + let olds = try EntryCoercionMap.find pair !entry_coercion_map with Not_found -> [] in + EntryCoercionMap.add pair (insert_coercion_path path olds)) + (((entry,entry'),((lev,lev'),[ntn]))::toaddright@toaddleft) + !entry_coercion_map + +let entry_has_global_map = ref String.Map.empty + +let declare_custom_entry_has_global s n = + try + let p = String.Map.find s !entry_has_global_map in + user_err (str "Custom entry " ++ str s ++ + str " has already a rule for global references at level " ++ int p ++ str ".") + with Not_found -> + entry_has_global_map := String.Map.add s n !entry_has_global_map + +let entry_has_global = function + | InConstrEntrySomeLevel -> true + | InCustomEntryLevel (s,n) -> + try String.Map.find s !entry_has_global_map <= n with Not_found -> false + +let entry_has_ident_map = ref String.Map.empty + +let declare_custom_entry_has_ident s n = + try + let p = String.Map.find s !entry_has_ident_map in + user_err (str "Custom entry " ++ str s ++ + str " has already a rule for global references at level " ++ int p ++ str ".") + with Not_found -> + entry_has_ident_map := String.Map.add s n !entry_has_ident_map + +let entry_has_ident = function + | InConstrEntrySomeLevel -> true + | InCustomEntryLevel (s,n) -> + try String.Map.find s !entry_has_ident_map <= n with Not_found -> false + let uninterp_prim_token c = try let (sc,numpr,_) = @@ -565,7 +706,8 @@ let ntpe_eq t1 t2 = match t1, t2 with | NtnTypeBinderList, NtnTypeBinderList -> true | (NtnTypeConstr | NtnTypeBinder _ | NtnTypeConstrList | NtnTypeBinderList), _ -> false -let var_attributes_eq (_, (sc1, tp1)) (_, (sc2, tp2)) = +let var_attributes_eq (_, ((entry1, sc1), tp1)) (_, ((entry2, sc2), tp2)) = + notation_entry_level_eq entry1 entry2 && pair_eq (Option.equal String.equal) (List.equal String.equal) sc1 sc2 && ntpe_eq tp1 tp2 @@ -577,7 +719,7 @@ let exists_notation_in_scope scopt ntn onlyprint r = let scope = match scopt with Some s -> s | None -> default_scope in try let sc = String.Map.find scope !scope_map in - let n = String.Map.find ntn sc.notations in + let n = NotationMap.find ntn sc.notations in interpretation_eq n.not_interp r with Not_found -> false @@ -793,10 +935,10 @@ let rec string_of_symbol = function let l = List.flatten (List.map string_of_symbol l) in "_"::l@".."::l@["_"] | Break _ -> [] -let make_notation_key symbols = - String.concat " " (List.flatten (List.map string_of_symbol symbols)) +let make_notation_key from symbols = + (from,String.concat " " (List.flatten (List.map string_of_symbol symbols))) -let decompose_notation_key s = +let decompose_notation_key (from,s) = let len = String.length s in let rec decomp_ntn dirs n = if n>=len then List.rev dirs else @@ -811,7 +953,7 @@ let decompose_notation_key s = | s -> Terminal (String.drop_simple_quotes s) in decomp_ntn (tok::dirs) (pos+1) in - decomp_ntn [] 0 + from, decomp_ntn [] 0 (************) (* Printing *) @@ -840,14 +982,14 @@ let pr_notation_info prglob ntn c = let pr_named_scope prglob scope sc = (if String.equal scope default_scope then - match String.Map.cardinal sc.notations with + match NotationMap.cardinal sc.notations with | 0 -> str "No lonely notation" | n -> str "Lonely notation" ++ (if Int.equal n 1 then mt() else str"s") else str "Scope " ++ str scope ++ fnl () ++ pr_delimiters_info sc.delimiters) ++ fnl () ++ pr_scope_classes scope - ++ String.Map.fold + ++ NotationMap.fold (fun ntn { not_interp = (_, r); not_location = (_, df) } strm -> pr_notation_info prglob df r ++ fnl () ++ strm) sc.notations (mt ()) @@ -862,11 +1004,11 @@ let pr_scopes prglob = let rec find_default ntn = function | [] -> None | Scope scope :: scopes -> - if String.Map.mem ntn (find_scope scope).notations then + if NotationMap.mem ntn (find_scope scope).notations then Some scope else find_default ntn scopes | SingleNotation ntn' :: scopes -> - if String.equal ntn ntn' then Some default_scope + if notation_eq ntn ntn' then Some default_scope else find_default ntn scopes let factorize_entries = function @@ -875,7 +1017,7 @@ let factorize_entries = function let (ntn,l_of_ntn,rest) = List.fold_left (fun (a',l,rest) (a,c) -> - if String.equal a a' then (a',c::l,rest) else (a,[c],(a',l)::rest)) + if notation_eq a a' then (a',c::l,rest) else (a,[c],(a',l)::rest)) (ntn,[c],[]) l in (ntn,l_of_ntn)::rest @@ -930,15 +1072,15 @@ let possible_notations ntn = (* Only "_ U _" format *) [ntn] else - let ntn' = make_notation_key (raw_analyze_notation_tokens toks) in + let _,ntn' = make_notation_key None (raw_analyze_notation_tokens toks) in if String.equal ntn ntn' then (* Only symbols *) [ntn] else [ntn;ntn'] let browse_notation strict ntn map = let ntns = possible_notations ntn in - let find ntn' ntn = + let find (from,ntn' as fullntn') ntn = if String.contains ntn ' ' then String.equal ntn ntn' else - let toks = decompose_notation_key ntn' in + let _,toks = decompose_notation_key fullntn' in let get_terminals = function Terminal ntn -> Some ntn | _ -> None in let trms = List.map_filter get_terminals toks in if strict then String.List.equal [ntn] trms @@ -947,10 +1089,10 @@ let browse_notation strict ntn map = let l = String.Map.fold (fun scope_name sc -> - String.Map.fold (fun ntn { not_interp = (_, r); not_location = df } l -> + NotationMap.fold (fun ntn { not_interp = (_, r); not_location = df } l -> if List.exists (find ntn) ntns then (ntn,(scope_name,r,df))::l else l) sc.notations) map [] in - List.sort (fun x y -> String.compare (fst x) (fst y)) l + List.sort (fun x y -> String.compare (snd (fst x)) (snd (fst y))) l let global_reference_of_notation test (ntn,(sc,c,_)) = match c with @@ -1011,9 +1153,9 @@ let locate_notation prglob ntn scope = let collect_notation_in_scope scope sc known = assert (not (String.equal scope default_scope)); - String.Map.fold + NotationMap.fold (fun ntn { not_interp = (_, r); not_location = (_, df) } (l,known as acc) -> - if String.List.mem ntn known then acc else ((df,r)::l,ntn::known)) + if List.mem_f notation_eq ntn known then acc else ((df,r)::l,ntn::known)) sc.notations ([],known) let collect_notations stack = @@ -1026,10 +1168,10 @@ let collect_notations stack = collect_notation_in_scope scope (find_scope scope) knownntn in ((scope,l)::all,knownntn) | SingleNotation ntn -> - if String.List.mem ntn knownntn then (all,knownntn) + if List.mem_f notation_eq ntn knownntn then (all,knownntn) else let { not_interp = (_, r); not_location = (_, df) } = - String.Map.find ntn (find_scope default_scope).notations in + NotationMap.find ntn (find_scope default_scope).notations in let all' = match all with | (s,lonelyntn)::rest when String.equal s default_scope -> (s,(df,r)::lonelyntn)::rest @@ -1063,15 +1205,20 @@ let pr_visibility prglob = function let freeze _ = (!scope_map, !scope_stack, !arguments_scope, - !delimiters_map, !notations_key_table, !scope_class_map) + !delimiters_map, !notations_key_table, !scope_class_map, + !entry_coercion_map, !entry_has_global_map, + !entry_has_ident_map) -let unfreeze (scm,scs,asc,dlm,fkm,clsc) = +let unfreeze (scm,scs,asc,dlm,fkm,clsc,coe,globs,ids) = scope_map := scm; scope_stack := scs; delimiters_map := dlm; arguments_scope := asc; notations_key_table := fkm; - scope_class_map := clsc + scope_class_map := clsc; + entry_coercion_map := coe; + entry_has_global_map := globs; + entry_has_ident_map := ids let init () = init_scope_map (); diff --git a/interp/notation.mli b/interp/notation.mli index b177b7f1e0..c921606484 100644 --- a/interp/notation.mli +++ b/interp/notation.mli @@ -17,6 +17,21 @@ open Notation_term (** Notations *) +val pr_notation : notation -> Pp.t +(** Printing *) + +val notation_entry_eq : notation_entry -> notation_entry -> bool +(** Equality on [notation_entry]. *) + +val notation_entry_level_eq : notation_entry_level -> notation_entry_level -> bool +(** Equality on [notation_entry_level]. *) + +val notation_eq : notation -> notation -> bool +(** Equality on [notation]. *) + +module NotationSet : Set.S with type elt = notation +module NotationMap : CMap.ExtS with type key = notation and module Set := NotationSet + (** {6 Scopes } *) (** A scope is a set of interpreters for symbols + optional interpreter and printers for integers + optional delimiters *) @@ -25,8 +40,6 @@ type delimiters = string type scope type scopes (** = [scope_name list] *) -type local_scopes = tmp_scope_name option * scope_name list - val declare_scope : scope_name -> unit val current_scopes : unit -> scopes @@ -84,11 +97,11 @@ val declare_string_interpreter : scope_name -> required_module -> (** Return the [term]/[cases_pattern] bound to a primitive token in a given scope context*) -val interp_prim_token : ?loc:Loc.t -> prim_token -> local_scopes -> +val interp_prim_token : ?loc:Loc.t -> prim_token -> subscopes -> glob_constr * (notation_location * scope_name option) (* This function returns a glob_const representing a pattern *) val interp_prim_token_cases_pattern_expr : ?loc:Loc.t -> (GlobRef.t -> unit) -> prim_token -> - local_scopes -> glob_constr * (notation_location * scope_name option) + subscopes -> glob_constr * (notation_location * scope_name option) (** Return the primitive token associated to a [term]/[cases_pattern]; raise [No_match] if no such token *) @@ -101,7 +114,7 @@ val uninterp_prim_token_ind_pattern : inductive -> cases_pattern list -> scope_name * prim_token val availability_of_prim_token : - prim_token -> scope_name -> local_scopes -> delimiters option option + prim_token -> scope_name -> subscopes -> delimiters option option (** {6 Declare and interpret back and forth a notation } *) @@ -116,7 +129,7 @@ val declare_notation_interpretation : notation -> scope_name option -> val declare_uninterpretation : interp_rule -> interpretation -> unit (** Return the interpretation bound to a notation *) -val interp_notation : ?loc:Loc.t -> notation -> local_scopes -> +val interp_notation : ?loc:Loc.t -> notation -> subscopes -> interpretation * (notation_location * scope_name option) type notation_rule = interp_rule * interpretation * int option @@ -129,13 +142,13 @@ val uninterp_ind_pattern_notations : inductive -> notation_rule list (** Test if a notation is available in the scopes context [scopes]; if available, the result is not None; the first argument is itself not None if a delimiters is needed *) -val availability_of_notation : scope_name option * notation -> local_scopes -> +val availability_of_notation : scope_name option * notation -> subscopes -> (scope_name option * delimiters option) option (** {6 Miscellaneous} *) val interp_notation_as_global_reference : ?loc:Loc.t -> (GlobRef.t -> bool) -> - notation -> delimiters option -> GlobRef.t + notation_key -> delimiters option -> GlobRef.t (** Checks for already existing notations *) val exists_notation_in_scope : scope_name option -> notation -> @@ -177,8 +190,8 @@ type symbol = val symbol_eq : symbol -> symbol -> bool (** Make/decompose a notation of the form "_ U _" *) -val make_notation_key : symbol list -> notation -val decompose_notation_key : notation -> symbol list +val make_notation_key : notation_entry_level -> symbol list -> notation +val decompose_notation_key : notation -> notation_entry_level * symbol list (** Decompose a notation of the form "a 'U' b" *) val decompose_raw_notation : string -> symbol list @@ -187,11 +200,21 @@ val decompose_raw_notation : string -> symbol list val pr_scope_class : scope_class -> Pp.t val pr_scope : (glob_constr -> Pp.t) -> scope_name -> Pp.t val pr_scopes : (glob_constr -> Pp.t) -> Pp.t -val locate_notation : (glob_constr -> Pp.t) -> notation -> +val locate_notation : (glob_constr -> Pp.t) -> notation_key -> scope_name option -> Pp.t val pr_visibility: (glob_constr -> Pp.t) -> scope_name option -> Pp.t +type entry_coercion = notation list +val declare_entry_coercion : notation -> notation_entry_level -> unit +val availability_of_entry_coercion : notation_entry_level -> notation_entry_level -> entry_coercion option + +val declare_custom_entry_has_global : string -> int -> unit +val declare_custom_entry_has_ident : string -> int -> unit + +val entry_has_global : notation_entry_level -> bool +val entry_has_ident : notation_entry_level -> bool + (** Rem: printing rules for primitive token are canonical *) val with_notation_protection : ('a -> 'b) -> 'a -> 'b diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index 7cde563cd2..06943ce7b9 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -1008,9 +1008,9 @@ let remove_sigma x (terms,termlists,binders,binderlists) = let remove_bindinglist_sigma x (terms,termlists,binders,binderlists) = (terms,termlists,binders,Id.List.remove_assoc x binderlists) -let add_ldots_var metas = (ldots_var,((None,[]),NtnTypeConstr))::metas +let add_ldots_var metas = (ldots_var,((Constrexpr.InConstrEntrySomeLevel,(None,[])),NtnTypeConstr))::metas -let add_meta_bindinglist x metas = (x,((None,[]),NtnTypeBinderList))::metas +let add_meta_bindinglist x metas = (x,((Constrexpr.InConstrEntrySomeLevel,(None,[])),NtnTypeBinderList))::metas (* This tells if letins in the middle of binders should be included in the sequence of binders *) @@ -1055,7 +1055,7 @@ let match_binderlist match_fun alp metas sigma rest x y iter termin revert = let alp,sigma = bind_bindinglist_env alp sigma x bl in match_fun alp metas sigma rest termin -let add_meta_term x metas = (x,((None,[]),NtnTypeConstr))::metas +let add_meta_term x metas = (x,((Constrexpr.InConstrEntrySomeLevel,(None,[])),NtnTypeConstr))::metas (* Should reuse the scope of the partner of x! *) let match_termlist match_fun alp metas sigma rest x y iter termin revert = let rec aux sigma acc rest = diff --git a/interp/notation_ops.mli b/interp/notation_ops.mli index f038b5be1a..58fa221b16 100644 --- a/interp/notation_ops.mli +++ b/interp/notation_ops.mli @@ -53,18 +53,18 @@ val glob_constr_of_notation_constr : ?loc:Loc.t -> notation_constr -> glob_const exception No_match val match_notation_constr : bool -> 'a glob_constr_g -> interpretation -> - ('a glob_constr_g * subscopes) list * ('a glob_constr_g list * subscopes) list * - ('a cases_pattern_disjunction_g * subscopes) list * - ('a extended_glob_local_binder_g list * subscopes) list + ('a glob_constr_g * extended_subscopes) list * ('a glob_constr_g list * extended_subscopes) list * + ('a cases_pattern_disjunction_g * extended_subscopes) list * + ('a extended_glob_local_binder_g list * extended_subscopes) list val match_notation_constr_cases_pattern : 'a cases_pattern_g -> interpretation -> - (('a cases_pattern_g * subscopes) list * ('a cases_pattern_g list * subscopes) list) * + (('a cases_pattern_g * extended_subscopes) list * ('a cases_pattern_g list * extended_subscopes) list) * (int * 'a cases_pattern_g list) val match_notation_constr_ind_pattern : inductive -> 'a cases_pattern_g list -> interpretation -> - (('a cases_pattern_g * subscopes) list * ('a cases_pattern_g list * subscopes) list) * + (('a cases_pattern_g * extended_subscopes) list * ('a cases_pattern_g list * extended_subscopes) list) * (int * 'a cases_pattern_g list) (** {5 Matching a notation pattern against a [glob_constr]} *) diff --git a/interp/notation_term.ml b/interp/notation_term.ml index 6d9effcef4..942ea5ff3f 100644 --- a/interp/notation_term.ml +++ b/interp/notation_term.ml @@ -58,6 +58,8 @@ type tmp_scope_name = scope_name type subscopes = tmp_scope_name option * scope_name list +type extended_subscopes = Constrexpr.notation_entry_level * subscopes + (** Type of the meta-variables of an notation_constr: in a recursive pattern x..y, x carries the sequence of objects bound to the list x..y *) @@ -86,7 +88,7 @@ type notation_var_internalization_type = (** This characterizes to what a notation is interpreted to *) type interpretation = - (Id.t * (subscopes * notation_var_instance_type)) list * + (Id.t * (extended_subscopes * notation_var_instance_type)) list * notation_constr type reversibility_status = APrioriReversible | HasLtac | NonInjective of Id.t list diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml index a4f20fd739..e3d490a1ad 100644 --- a/interp/syntax_def.ml +++ b/interp/syntax_def.ml @@ -77,8 +77,8 @@ type syndef_interpretation = (Id.t * subscopes) list * notation_constr (* Coercions to the general format of notation that also supports variables bound to list of expressions *) -let in_pat (ids,ac) = (List.map (fun (id,sc) -> (id,(sc,NtnTypeConstr))) ids,ac) -let out_pat (ids,ac) = (List.map (fun (id,(sc,typ)) -> (id,sc)) ids,ac) +let in_pat (ids,ac) = (List.map (fun (id,sc) -> (id,((Constrexpr.InConstrEntrySomeLevel,sc),NtnTypeConstr))) ids,ac) +let out_pat (ids,ac) = (List.map (fun (id,((_,sc),typ)) -> (id,sc)) ids,ac) let declare_syntactic_definition local id onlyparse pat = let _ = add_leaf id (in_syntax_constant (local,in_pat pat,onlyparse)) in () diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml index 4613cd3214..e336ea922d 100644 --- a/kernel/cbytegen.ml +++ b/kernel/cbytegen.ml @@ -501,6 +501,9 @@ let rec compile_lam env cenv lam sz cont = if Array.is_empty args then compile_fv_elem cenv (FVevar evk) sz cont else + (** Arguments are reversed in evar instances *) + let args = Array.copy args in + let () = Array.rev args in comp_app compile_fv_elem (compile_lam env) cenv (FVevar evk) args sz cont | Lconst (kn,u) -> compile_constant env cenv kn u [||] sz cont diff --git a/kernel/context.ml b/kernel/context.ml index 831dc850fb..4a7204b75c 100644 --- a/kernel/context.ml +++ b/kernel/context.ml @@ -149,6 +149,10 @@ struct | LocalAssum (na, ty) -> na, None, ty | LocalDef (na, v, ty) -> na, Some v, ty + let drop_body = function + | LocalAssum _ as d -> d + | LocalDef (na, v, ty) -> LocalAssum (na, ty) + end (** Rel-context is represented as a list of declarations. @@ -211,6 +215,8 @@ struct | Declaration.LocalAssum _ :: ctx -> aux (false::l) ctx in aux [] l + let drop_bodies l = List.Smart.map Declaration.drop_body l + (** [extended_list n Γ] builds an instance [args] such that [Γ,Δ ⊢ args:Γ] with n = |Δ| and with the {e local definitions} of [Γ] skipped in [args]. Example: for [x:T, y:=c, z:U] and [n]=2, it gives [Rel 5, Rel 3]. *) @@ -348,6 +354,10 @@ struct | id, None, ty -> LocalAssum (id, ty) | id, Some v, ty -> LocalDef (id, v, ty) + let drop_body = function + | LocalAssum _ as d -> d + | LocalDef (id, v, ty) -> LocalAssum (id, ty) + let of_rel_decl f = function | Rel.Declaration.LocalAssum (na,t) -> LocalAssum (f na, t) @@ -403,6 +413,8 @@ struct let to_vars l = List.fold_left (fun accu decl -> Id.Set.add (Declaration.get_id decl) accu) Id.Set.empty l + let drop_bodies l = List.Smart.map Declaration.drop_body l + (** [instance_from_named_context Ω] builds an instance [args] such that [Ω ⊢ args:Ω] where [Ω] is a named context and with the local definitions of [Ω] skipped. Example: for [id1:T,id2:=c,id3:U], it diff --git a/kernel/context.mli b/kernel/context.mli index 957ac4b3d6..2b0d36cb8c 100644 --- a/kernel/context.mli +++ b/kernel/context.mli @@ -85,6 +85,9 @@ sig val fold_constr : ('c -> 'a -> 'a) -> ('c, 'c) pt -> 'a -> 'a val to_tuple : ('c, 't) pt -> Name.t * 'c option * 't + + (** Turn [LocalDef] into [LocalAssum], identity otherwise. *) + val drop_body : ('c, 't) pt -> ('c, 't) pt end (** Rel-context is represented as a list of declarations. @@ -129,6 +132,9 @@ sig and each {e local definition} is mapped to [false]. *) val to_tags : ('c, 't) pt -> bool list + (** Turn all [LocalDef] into [LocalAssum], leave [LocalAssum] unchanged. *) + val drop_bodies : ('c, 't) pt -> ('c, 't) pt + (** [extended_list mk n Γ] builds an instance [args] such that [Γ,Δ ⊢ args:Γ] with n = |Δ| and with the {e local definitions} of [Γ] skipped in [args] where [mk] is used to build the corresponding variables. @@ -202,6 +208,9 @@ sig val to_tuple : ('c, 't) pt -> Id.t * 'c option * 't val of_tuple : Id.t * 'c option * 't -> ('c, 't) pt + (** Turn [LocalDef] into [LocalAssum], identity otherwise. *) + val drop_body : ('c, 't) pt -> ('c, 't) pt + (** Convert [Rel.Declaration.t] value to the corresponding [Named.Declaration.t] value. The function provided as the first parameter determines how to translate "names" to "ids". *) val of_rel_decl : (Name.t -> Id.t) -> ('c, 't) Rel.Declaration.pt -> ('c, 't) pt @@ -249,6 +258,9 @@ sig (** Return the set of all identifiers bound in a given named-context. *) val to_vars : ('c, 't) pt -> Id.Set.t + (** Turn all [LocalDef] into [LocalAssum], leave [LocalAssum] unchanged. *) + val drop_bodies : ('c, 't) pt -> ('c, 't) pt + (** [to_instance Ω] builds an instance [args] such that [Ω ⊢ args:Ω] where [Ω] is a named-context and with the local definitions of [Ω] skipped. Example: for [id1:T,id2:=c,id3:U], it diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml index e97dbd0d67..931b8bbc86 100644 --- a/kernel/nativeconv.ml +++ b/kernel/nativeconv.ml @@ -135,7 +135,18 @@ and conv_fix env lvl t1 f1 t2 f2 cu = else aux (i+1) (conv_val env CONV flvl fi1 fi2 cu) in aux 0 cu +let warn_no_native_compiler = + let open Pp in + CWarnings.create ~name:"native-compiler-disabled" ~category:"native-compiler" + (fun () -> strbrk "Native compiler is disabled," ++ + strbrk " falling back to VM conversion test.") + let native_conv_gen pb sigma env univs t1 t2 = + if not Coq_config.native_compiler then begin + warn_no_native_compiler (); + Vconv.vm_conv_gen pb env univs t1 t2 + end + else let ml_filename, prefix = get_ml_filename () in let code, upds = mk_conv_code env sigma prefix t1 t2 in match compile ml_filename code ~profile:false with @@ -152,19 +163,8 @@ let native_conv_gen pb sigma env univs t1 t2 = end | _ -> anomaly (Pp.str "Compilation failure.") -let warn_no_native_compiler = - let open Pp in - CWarnings.create ~name:"native-compiler-disabled" ~category:"native-compiler" - (fun () -> strbrk "Native compiler is disabled," ++ - strbrk " falling back to VM conversion test.") - (* Wrapper for [native_conv] above *) let native_conv cv_pb sigma env t1 t2 = - if not Coq_config.native_compiler then begin - warn_no_native_compiler (); - Vconv.vm_conv cv_pb env t1 t2 - end - else let univs = Environ.universes env in let b = if cv_pb = CUMUL then Constr.leq_constr_univs univs t1 t2 diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml index 31ad364911..f784509b6f 100644 --- a/kernel/nativelib.ml +++ b/kernel/nativelib.ml @@ -67,6 +67,7 @@ let warn_native_compiler_failed = CWarnings.create ~name:"native-compiler-failed" ~category:"native-compiler" print let call_compiler ?profile:(profile=false) ml_filename = + let () = assert Coq_config.native_compiler in let load_path = !get_load_paths () in let load_path = List.map (fun dn -> dn / output_dir) load_path in let include_dirs = List.flatten (List.map (fun x -> ["-I"; x]) (include_dirs () @ load_path)) in diff --git a/library/goptions.ml b/library/goptions.ml index f14ad333e9..eafcb8fea6 100644 --- a/library/goptions.ml +++ b/library/goptions.ml @@ -318,26 +318,35 @@ let set_option_value ?(locality = OptDefault) check_and_cast key v = | Some (name, depr, (read,write,append)) -> write locality (check_and_cast v (read ())) -let bad_type_error () = user_err Pp.(str "Bad type of value for this option.") +let show_value_type = function + | BoolValue _ -> "bool" + | IntValue _ -> "int" + | StringValue _ -> "string" + | StringOptValue _ -> "string" + +let bad_type_error opt_value actual_type = + user_err Pp.(str "Bad type of value for this option:" ++ spc() ++ + str "expected " ++ str (show_value_type opt_value) ++ + str ", got " ++ str actual_type ++ str ".") let check_int_value v = function | IntValue _ -> IntValue v - | _ -> bad_type_error () + | optv -> bad_type_error optv "int" let check_bool_value v = function | BoolValue _ -> BoolValue v - | _ -> bad_type_error () + | optv -> bad_type_error optv "bool" let check_string_value v = function | StringValue _ -> StringValue v | StringOptValue _ -> StringOptValue (Some v) - | _ -> bad_type_error () + | optv -> bad_type_error optv "string" let check_unset_value v = function | BoolValue _ -> BoolValue false | IntValue _ -> IntValue None | StringOptValue _ -> StringOptValue None - | _ -> bad_type_error () + | optv -> bad_type_error optv "nothing" (* Nota: For compatibility reasons, some errors are treated as warning. This allows a script to refer to an option that doesn't diff --git a/library/lib.ml b/library/lib.ml index 8b83261e48..8ebe44890c 100644 --- a/library/lib.ml +++ b/library/lib.ml @@ -26,13 +26,11 @@ type node = | Leaf of obj | CompilingLibrary of object_prefix | OpenedModule of is_type * export * object_prefix * Summary.frozen - | ClosedModule of library_segment | OpenedSection of object_prefix * Summary.frozen - | ClosedSection of library_segment -and library_entry = object_name * node +type library_entry = object_name * node -and library_segment = library_entry list +type library_segment = library_entry list type lib_objects = (Names.Id.t * obj) list @@ -73,10 +71,6 @@ let classify_segment seg = clean ((id,o')::substl, keepl, anticipl) stk | Anticipate o' -> clean (substl, keepl, o'::anticipl) stk) - | (_,ClosedSection _) :: stk -> clean acc stk - (* LEM; TODO: Understand what this does and see if what I do is the - correct thing for ClosedMod(ule|type) *) - | (_,ClosedModule _) :: stk -> clean acc stk | (_,OpenedSection _) :: _ -> user_err Pp.(str "there are still opened sections") | (_,OpenedModule (ty,_,_,_)) :: _ -> user_err ~hdr:"Lib.classify_segment" @@ -307,7 +301,6 @@ let end_mod is_type = in let (after,mark,before) = split_lib_at_opening oname in lib_state := { !lib_state with lib_stk = before }; - add_entry oname (ClosedModule (List.rev (mark::after))); let prefix = !lib_state.path_prefix in recalc_path_prefix (); (oname, prefix, fs, after) @@ -555,7 +548,6 @@ let discharge_item ((sp,_ as oname),e) = match e with | Leaf lobj -> Option.map (fun o -> (basename sp,o)) (discharge_object (oname,lobj)) - | ClosedSection _ | ClosedModule _ -> None | OpenedSection _ | OpenedModule _ | CompilingLibrary _ -> anomaly (Pp.str "discharge_item.") @@ -570,7 +562,6 @@ let close_section () = let (secdecls,mark,before) = split_lib_at_opening oname in lib_state := { !lib_state with lib_stk = before }; pop_path_prefix (); - add_entry oname (ClosedSection (List.rev (mark::secdecls))); let newdecls = List.map discharge_item secdecls in Summary.unfreeze_summaries fs; List.iter (Option.iter (fun (id,o) -> add_discharged_leaf id o)) newdecls @@ -589,10 +580,8 @@ let freeze ~marshallable = | n, (CompilingLibrary _ as x) -> Some (n,x) | n, OpenedModule (it,e,op,_) -> Some(n,OpenedModule(it,e,op,Summary.empty_frozen)) - | n, ClosedModule _ -> Some (n,ClosedModule []) | n, OpenedSection (op, _) -> - Some(n,OpenedSection(op,Summary.empty_frozen)) - | n, ClosedSection _ -> Some (n,ClosedSection [])) + Some(n,OpenedSection(op,Summary.empty_frozen))) !lib_state.lib_stk in { !lib_state with lib_stk } | _ -> diff --git a/library/lib.mli b/library/lib.mli index c6856a55b4..9933b762ba 100644 --- a/library/lib.mli +++ b/library/lib.mli @@ -23,11 +23,9 @@ type node = | Leaf of Libobject.obj | CompilingLibrary of Libnames.object_prefix | OpenedModule of is_type * export * Libnames.object_prefix * Summary.frozen - | ClosedModule of library_segment | OpenedSection of Libnames.object_prefix * Summary.frozen - | ClosedSection of library_segment -and library_segment = (Libnames.object_name * node) list +type library_segment = (Libnames.object_name * node) list type lib_objects = (Id.t * Libobject.obj) list diff --git a/parsing/extend.ml b/parsing/extend.ml index f57e32c884..6fe2956643 100644 --- a/parsing/extend.ml +++ b/parsing/extend.ml @@ -34,14 +34,12 @@ type production_level = (** User-level types used to tell how to parse or interpret of the non-terminal *) type 'a constr_entry_key_gen = - | ETName - | ETReference + | ETIdent + | ETGlobal | ETBigint | ETBinder of bool (* open list of binders if true, closed list of binders otherwise *) - | ETConstr of 'a - | ETConstrAsBinder of Notation_term.constr_as_binder_kind * 'a + | ETConstr of Constrexpr.notation_entry * Notation_term.constr_as_binder_kind option * 'a | ETPattern of bool * int option (* true = strict pattern, i.e. not a single variable *) - | ETOther of string * string (** Entries level (left-hand side of grammar rules) *) @@ -63,9 +61,8 @@ type constr_prod_entry_key = | ETProdName (* Parsed as a name (ident or _) *) | ETProdReference (* Parsed as a global reference *) | ETProdBigint (* Parsed as an (unbounded) integer *) - | ETProdConstr of (production_level * production_position) (* Parsed as constr or pattern *) + | ETProdConstr of Constrexpr.notation_entry * (production_level * production_position) (* Parsed as constr or pattern, or a subentry of those *) | ETProdPattern of int (* Parsed as pattern as a binder (as subpart of a constr) *) - | ETProdOther of string * string (* Intended for embedding custom entries in constr or pattern *) | ETProdConstrList of (production_level * production_position) * Tok.t list (* Parsed as non-empty list of constr *) | ETProdBinderList of binder_entry_kind (* Parsed as non-empty list of local binders *) diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg index b2913d5d4f..49e1cd7ec9 100644 --- a/parsing/g_constr.mlg +++ b/parsing/g_constr.mlg @@ -225,11 +225,11 @@ GRAMMAR EXTEND Gram | "("; c = operconstr LEVEL "200"; ")" -> { (match c.CAst.v with | CPrim (Numeral (n,true)) -> - CAst.make ~loc @@ CNotation("( _ )",([c],[],[],[])) + CAst.make ~loc @@ CNotation((InConstrEntrySomeLevel,"( _ )"),([c],[],[],[])) | _ -> c) } | "{|"; c = record_declaration; "|}" -> { c } | "{"; c = binder_constr ; "}" -> - { CAst.make ~loc @@ CNotation(("{ _ }"),([c],[],[],[])) } + { CAst.make ~loc @@ CNotation((InConstrEntrySomeLevel,"{ _ }"),([c],[],[],[])) } | "`{"; c = operconstr LEVEL "200"; "}" -> { CAst.make ~loc @@ CGeneralization (Implicit, None, c) } | "`("; c = operconstr LEVEL "200"; ")" -> @@ -411,13 +411,13 @@ GRAMMAR EXTEND Gram | "("; p = pattern LEVEL "200"; ")" -> { (match p.CAst.v with | CPatPrim (Numeral (n,true)) -> - CAst.make ~loc @@ CPatNotation("( _ )",([p],[]),[]) + CAst.make ~loc @@ CPatNotation((InConstrEntrySomeLevel,"( _ )"),([p],[]),[]) | _ -> p) } | "("; p = pattern LEVEL "200"; ":"; ty = lconstr; ")" -> { let p = match p with | { CAst.v = CPatPrim (Numeral (n,true)) } -> - CAst.make ~loc @@ CPatNotation("( _ )",([p],[]),[]) + CAst.make ~loc @@ CPatNotation((InConstrEntrySomeLevel,"( _ )"),([p],[]),[]) | _ -> p in CAst.make ~loc @@ CPatCast (p, ty) } diff --git a/parsing/notation_gram.ml b/parsing/notation_gram.ml index 346350641f..d8c08803b6 100644 --- a/parsing/notation_gram.ml +++ b/parsing/notation_gram.ml @@ -17,7 +17,8 @@ type precedence = int type parenRelation = L | E | Any | Prec of precedence type tolerability = precedence * parenRelation -type level = precedence * tolerability list * constr_entry_key list +type level = Constrexpr.notation_entry * precedence * tolerability list * constr_entry_key list + (* first argument is InCustomEntry s for custom entries *) type grammar_constr_prod_item = | GramConstrTerminal of Tok.t diff --git a/parsing/notgram_ops.ml b/parsing/notgram_ops.ml index 071e6db205..c36b3b17bf 100644 --- a/parsing/notgram_ops.ml +++ b/parsing/notgram_ops.ml @@ -11,55 +11,59 @@ open Pp open CErrors open Util -open Extend +open Notation open Notation_gram (* Uninterpreted notation levels *) -let notation_level_map = Summary.ref ~name:"notation_level_map" String.Map.empty +let notation_level_map = Summary.ref ~name:"notation_level_map" NotationMap.empty let declare_notation_level ?(onlyprint=false) ntn level = - if String.Map.mem ntn !notation_level_map then - anomaly (str "Notation " ++ str ntn ++ str " is already assigned a level."); - notation_level_map := String.Map.add ntn (level,onlyprint) !notation_level_map + if NotationMap.mem ntn !notation_level_map then + anomaly (str "Notation " ++ pr_notation ntn ++ str " is already assigned a level."); + notation_level_map := NotationMap.add ntn (level,onlyprint) !notation_level_map let level_of_notation ?(onlyprint=false) ntn = - let (level,onlyprint') = String.Map.find ntn !notation_level_map in + let (level,onlyprint') = NotationMap.find ntn !notation_level_map in if onlyprint' && not onlyprint then raise Not_found; level (**********************************************************************) -(* Operations on scopes *) +(* Equality *) + +open Extend let parenRelation_eq t1 t2 = match t1, t2 with | L, L | E, E | Any, Any -> true | Prec l1, Prec l2 -> Int.equal l1 l2 | _ -> false -let production_level_eq l1 l2 = true (* (l1 = l2) *) +let production_position_eq pp1 pp2 = match (pp1,pp2) with +| BorderProd (side1,assoc1), BorderProd (side2,assoc2) -> side1 = side2 && assoc1 = assoc2 +| InternalProd, InternalProd -> true +| (BorderProd _ | InternalProd), _ -> false -let production_position_eq pp1 pp2 = true (* pp1 = pp2 *) (* match pp1, pp2 with +let production_level_eq l1 l2 = match (l1,l2) with | NextLevel, NextLevel -> true | NumLevel n1, NumLevel n2 -> Int.equal n1 n2 -| (NextLevel | NumLevel _), _ -> false *) +| (NextLevel | NumLevel _), _ -> false let constr_entry_key_eq eq v1 v2 = match v1, v2 with -| ETName, ETName -> true -| ETReference, ETReference -> true +| ETIdent, ETIdent -> true +| ETGlobal, ETGlobal -> true | ETBigint, ETBigint -> true | ETBinder b1, ETBinder b2 -> b1 == b2 -| ETConstr lev1, ETConstr lev2 -> eq lev1 lev2 -| ETConstrAsBinder (bk1,lev1), ETConstrAsBinder (bk2,lev2) -> eq lev1 lev2 && bk1 = bk2 +| ETConstr (s1,bko1,lev1), ETConstr (s2,bko2,lev2) -> + notation_entry_eq s1 s2 && eq lev1 lev2 && Option.equal (=) bko1 bko2 | ETPattern (b1,n1), ETPattern (b2,n2) -> b1 = b2 && Option.equal Int.equal n1 n2 -| ETOther (s1,s1'), ETOther (s2,s2') -> String.equal s1 s2 && String.equal s1' s2' -| (ETName | ETReference | ETBigint | ETBinder _ | ETConstr _ | ETPattern _ | ETOther _ | ETConstrAsBinder _), _ -> false +| (ETIdent | ETGlobal | ETBigint | ETBinder _ | ETConstr _ | ETPattern _), _ -> false -let level_eq_gen strict (l1, t1, u1) (l2, t2, u2) = +let level_eq_gen strict (s1, l1, t1, u1) (s2, l2, t2, u2) = let tolerability_eq (i1, r1) (i2, r2) = Int.equal i1 i2 && parenRelation_eq r1 r2 in let prod_eq (l1,pp1) (l2,pp2) = - if strict then production_level_eq l1 l2 && production_position_eq pp1 pp2 - else production_level_eq l1 l2 in - Int.equal l1 l2 && List.equal tolerability_eq t1 t2 + not strict || + (production_level_eq l1 l2 && production_position_eq pp1 pp2) in + notation_entry_eq s1 s2 && Int.equal l1 l2 && List.equal tolerability_eq t1 t2 && List.equal (constr_entry_key_eq prod_eq) u1 u2 let level_eq = level_eq_gen false diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml index 6726603e60..eb3e633892 100644 --- a/parsing/pcoq.ml +++ b/parsing/pcoq.ml @@ -271,14 +271,21 @@ type gram_reinit = gram_assoc * gram_position type extend_rule = | ExtendRule : 'a G.entry * gram_reinit option * 'a extend_statement -> extend_rule +module EntryCommand = Dyn.Make () +module EntryData = struct type _ t = Ex : 'b G.entry String.Map.t -> ('a * 'b) t end +module EntryDataMap = EntryCommand.Map(EntryData) + type ext_kind = | ByGrammar of extend_rule | ByEXTEND of (unit -> unit) * (unit -> unit) + | ByEntry : ('a * 'b) EntryCommand.tag * string * 'b G.entry -> ext_kind (** The list of extensions *) let camlp5_state = ref [] +let camlp5_entries = ref EntryDataMap.empty + (** Deletion *) let grammar_delete e reinit (pos,rls) = @@ -344,7 +351,7 @@ module Gram = let rec remove_grammars n = if n>0 then - (match !camlp5_state with + match !camlp5_state with | [] -> anomaly ~label:"Pcoq.remove_grammars" (Pp.str "too many rules to remove.") | ByGrammar (ExtendRule (g, reinit, ext)) :: t -> grammar_delete g reinit (of_coq_extend_statement ext); @@ -355,7 +362,17 @@ let rec remove_grammars n = camlp5_state := t; remove_grammars n; redo(); - camlp5_state := ByEXTEND (undo,redo) :: !camlp5_state) + camlp5_state := ByEXTEND (undo,redo) :: !camlp5_state + | ByEntry (tag, name, e) :: t -> + G.Unsafe.clear_entry e; + camlp5_state := t; + let EntryData.Ex entries = + try EntryDataMap.find tag !camlp5_entries + with Not_found -> EntryData.Ex String.Map.empty + in + let entries = String.Map.remove name entries in + camlp5_entries := EntryDataMap.add tag (EntryData.Ex entries) !camlp5_entries; + remove_grammars (n - 1) let make_rule r = [None, None, r] @@ -517,59 +534,119 @@ module GrammarInterpMap = GrammarCommand.Map(GrammarInterp) let grammar_interp = ref GrammarInterpMap.empty -let (grammar_stack : (int * GrammarCommand.t * GramState.t) list ref) = ref [] +type ('a, 'b) entry_extension = 'a -> GramState.t -> string list * GramState.t + +module EntryInterp = struct type _ t = Ex : ('a, 'b) entry_extension -> ('a * 'b) t end +module EntryInterpMap = EntryCommand.Map(EntryInterp) + +let entry_interp = ref EntryInterpMap.empty + +type grammar_entry = +| GramExt of int * GrammarCommand.t +| EntryExt : int * ('a * 'b) EntryCommand.tag * 'a -> grammar_entry + +let (grammar_stack : (grammar_entry * GramState.t) list ref) = ref [] type 'a grammar_command = 'a GrammarCommand.tag +type ('a, 'b) entry_command = ('a * 'b) EntryCommand.tag let create_grammar_command name interp : _ grammar_command = let obj = GrammarCommand.create name in let () = grammar_interp := GrammarInterpMap.add obj interp !grammar_interp in obj +let create_entry_command name (interp : ('a, 'b) entry_extension) : ('a, 'b) entry_command = + let obj = EntryCommand.create name in + let () = entry_interp := EntryInterpMap.add obj (EntryInterp.Ex interp) !entry_interp in + obj + let extend_grammar_command tag g = let modify = GrammarInterpMap.find tag !grammar_interp in let grammar_state = match !grammar_stack with | [] -> GramState.empty - | (_, _, st) :: _ -> st + | (_, st) :: _ -> st in let (rules, st) = modify g grammar_state in let iter (ExtendRule (e, reinit, ext)) = grammar_extend_sync e reinit ext in let () = List.iter iter rules in let nb = List.length rules in - grammar_stack := (nb, GrammarCommand.Dyn (tag, g), st) :: !grammar_stack + grammar_stack := (GramExt (nb, GrammarCommand.Dyn (tag, g)), st) :: !grammar_stack -let recover_grammar_command (type a) (tag : a grammar_command) : a list = - let filter : _ -> a option = fun (_, GrammarCommand.Dyn (tag', v), _) -> - match GrammarCommand.eq tag tag' with - | None -> None - | Some Refl -> Some v +let extend_entry_command (type a) (type b) (tag : (a, b) entry_command) (g : a) : b Gram.entry list = + let EntryInterp.Ex modify = EntryInterpMap.find tag !entry_interp in + let grammar_state = match !grammar_stack with + | [] -> GramState.empty + | (_, st) :: _ -> st in - List.map_filter filter !grammar_stack + let (names, st) = modify g grammar_state in + let entries = List.map (fun name -> Gram.entry_create name) names in + let iter name e = + camlp5_state := ByEntry (tag, name, e) :: !camlp5_state; + let EntryData.Ex old = + try EntryDataMap.find tag !camlp5_entries + with Not_found -> EntryData.Ex String.Map.empty + in + let entries = String.Map.add name e old in + camlp5_entries := EntryDataMap.add tag (EntryData.Ex entries) !camlp5_entries + in + let () = List.iter2 iter names entries in + let nb = List.length entries in + let () = grammar_stack := (EntryExt (nb, tag, g), st) :: !grammar_stack in + entries + +let find_custom_entry tag name = + let EntryData.Ex map = EntryDataMap.find tag !camlp5_entries in + String.Map.find name map -let extend_dyn_grammar (GrammarCommand.Dyn (tag, g)) = extend_grammar_command tag g +let extend_dyn_grammar (e, _) = match e with +| GramExt (_, (GrammarCommand.Dyn (tag, g))) -> extend_grammar_command tag g +| EntryExt (_, tag, g) -> ignore (extend_entry_command tag g) -(* Summary functions: the state of the lexer is included in that of the parser. +(** Registering extra grammar *) + +type any_entry = AnyEntry : 'a Gram.entry -> any_entry + +let grammar_names : any_entry list String.Map.t ref = ref String.Map.empty + +let register_grammars_by_name name grams = + grammar_names := String.Map.add name grams !grammar_names + +let find_grammars_by_name name = + try String.Map.find name !grammar_names + with Not_found -> + let fold (EntryDataMap.Any (tag, EntryData.Ex map)) accu = + try AnyEntry (String.Map.find name map) :: accu + with Not_found -> accu + in + EntryDataMap.fold fold !camlp5_entries [] + +(** Summary functions: the state of the lexer is included in that of the parser. Because the grammar affects the set of keywords when adding or removing grammar rules. *) -type frozen_t = (int * GrammarCommand.t * GramState.t) list * CLexer.keyword_state +type frozen_t = + (grammar_entry * GramState.t) list * + CLexer.keyword_state -let freeze _ : frozen_t = (!grammar_stack, CLexer.get_keyword_state ()) +let freeze _ : frozen_t = + (!grammar_stack, CLexer.get_keyword_state ()) (* We compare the current state of the grammar and the state to unfreeze, by computing the longest common suffixes *) let factorize_grams l1 l2 = if l1 == l2 then ([], [], l1) else List.share_tails l1 l2 -let number_of_entries gcl = - List.fold_left (fun n (p,_,_) -> n + p) 0 gcl +let rec number_of_entries accu = function +| [] -> accu +| ((GramExt (p, _) | EntryExt (p, _, _)), _) :: rem -> + number_of_entries (p + accu) rem let unfreeze (grams, lex) = let (undo, redo, common) = factorize_grams !grammar_stack grams in - let n = number_of_entries undo in + let n = number_of_entries 0 undo in remove_grammars n; grammar_stack := common; CLexer.set_keyword_state lex; - List.iter extend_dyn_grammar (List.rev_map pi2 redo) + List.iter extend_dyn_grammar (List.rev redo) (** No need to provide an init function : the grammar state is statically available, and already empty initially, while @@ -603,15 +680,3 @@ let () = Grammar.register0 wit_sort_family (Constr.sort_family); Grammar.register0 wit_constr (Constr.constr); () - -(** Registering extra grammar *) - -type any_entry = AnyEntry : 'a Entry.t -> any_entry - -let grammar_names : any_entry list String.Map.t ref = ref String.Map.empty - -let register_grammars_by_name name grams = - grammar_names := String.Map.add name grams !grammar_names - -let find_grammars_by_name name = - String.Map.find name !grammar_names diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index 029c437136..e12ccaa636 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -233,6 +233,8 @@ val grammar_extend : 'a Entry.t -> gram_reinit option -> module GramState : Store.S (** Auxiliary state of the grammar. Any added data must be marshallable. *) +(** {6 Extension with parsing rules} *) + type 'a grammar_command (** Type of synchronized parsing extensions. The ['a] type should be marshallable. *) @@ -253,8 +255,30 @@ val create_grammar_command : string -> 'a grammar_extension -> 'a grammar_comman val extend_grammar_command : 'a grammar_command -> 'a -> unit (** Extend the grammar of Coq with the given data. *) -val recover_grammar_command : 'a grammar_command -> 'a list -(** Recover the current stack of grammar extensions. *) +(** {6 Extension with parsing entries} *) + +type ('a, 'b) entry_command +(** Type of synchronized entry creation. The ['a] type should be + marshallable. *) + +type ('a, 'b) entry_extension = 'a -> GramState.t -> string list * GramState.t +(** Entry extension entry point. Given some ['a] and a current grammar state, + such a function must produce the list of entry extensions that will be + created and kept synchronized w.r.t. the summary, together + with a new state. It should be pure. *) + +val create_entry_command : string -> ('a, 'b) entry_extension -> ('a, 'b) entry_command +(** Create a new entry-creating command with the given name. The extension + function is called to generate the new entries for a given data. *) + +val extend_entry_command : ('a, 'b) entry_command -> 'a -> 'b Entry.t list +(** Create new synchronized entries using the provided data. *) + +val find_custom_entry : ('a, 'b) entry_command -> string -> 'b Entry.t +(** Find an entry generated by the synchronized system in the current state. + @raise Not_found if non-existent. *) + +(** {6 Protection w.r.t. backtrack} *) val with_grammar_rule_protection : ('a -> 'b) -> 'a -> 'b diff --git a/parsing/ppextend.ml b/parsing/ppextend.ml index d2b50fa83d..e1f5e20117 100644 --- a/parsing/ppextend.ml +++ b/parsing/ppextend.ml @@ -11,6 +11,7 @@ open Util open Pp open CErrors +open Notation open Notation_gram (*s Pretty-print. *) @@ -48,29 +49,29 @@ type unparsing_rule = unparsing list * precedence type extra_unparsing_rules = (string * string) list (* Concrete syntax for symbolic-extension table *) let notation_rules = - Summary.ref ~name:"notation-rules" (String.Map.empty : (unparsing_rule * extra_unparsing_rules * notation_grammar) String.Map.t) + Summary.ref ~name:"notation-rules" (NotationMap.empty : (unparsing_rule * extra_unparsing_rules * notation_grammar) NotationMap.t) let declare_notation_rule ntn ~extra unpl gram = - notation_rules := String.Map.add ntn (unpl,extra,gram) !notation_rules + notation_rules := NotationMap.add ntn (unpl,extra,gram) !notation_rules let find_notation_printing_rule ntn = - try pi1 (String.Map.find ntn !notation_rules) - with Not_found -> anomaly (str "No printing rule found for " ++ str ntn ++ str ".") + try pi1 (NotationMap.find ntn !notation_rules) + with Not_found -> anomaly (str "No printing rule found for " ++ pr_notation ntn ++ str ".") let find_notation_extra_printing_rules ntn = - try pi2 (String.Map.find ntn !notation_rules) + try pi2 (NotationMap.find ntn !notation_rules) with Not_found -> [] let find_notation_parsing_rules ntn = - try pi3 (String.Map.find ntn !notation_rules) - with Not_found -> anomaly (str "No parsing rule found for " ++ str ntn ++ str ".") + try pi3 (NotationMap.find ntn !notation_rules) + with Not_found -> anomaly (str "No parsing rule found for " ++ pr_notation ntn ++ str ".") let get_defined_notations () = - String.Set.elements @@ String.Map.domain !notation_rules + NotationSet.elements @@ NotationMap.domain !notation_rules let add_notation_extra_printing_rule ntn k v = try notation_rules := - let p, pp, gr = String.Map.find ntn !notation_rules in - String.Map.add ntn (p, (k,v) :: pp, gr) !notation_rules + let p, pp, gr = NotationMap.find ntn !notation_rules in + NotationMap.add ntn (p, (k,v) :: pp, gr) !notation_rules with Not_found -> user_err ~hdr:"add_notation_extra_printing_rule" (str "No such Notation.") diff --git a/parsing/ppextend.mli b/parsing/ppextend.mli index 9f61e121a4..7eb5967a3e 100644 --- a/parsing/ppextend.mli +++ b/parsing/ppextend.mli @@ -41,7 +41,6 @@ type unparsing = type unparsing_rule = unparsing list * precedence type extra_unparsing_rules = (string * string) list - val declare_notation_rule : notation -> extra:extra_unparsing_rules -> unparsing_rule -> notation_grammar -> unit val find_notation_printing_rule : notation -> unparsing_rule val find_notation_extra_printing_rules : notation -> extra_unparsing_rules diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml index 4e3ba57308..516b04ea21 100644 --- a/plugins/firstorder/ground.ml +++ b/plugins/firstorder/ground.ml @@ -13,23 +13,21 @@ open Formula open Sequent open Rules open Instances -open Constr open Tacmach.New open Tacticals.New +open Globnames let update_flags ()= - let predref=ref Names.Cpred.empty in - let f coe= - try - let kn= fst (destConst (Classops.get_coercion_value coe)) in - predref:=Names.Cpred.add kn !predref - with DestKO -> () + let f acc coe = + match coe.Classops.coe_value with + | ConstRef c -> Names.Cpred.add c acc + | _ -> acc in - List.iter f (Classops.coercions ()); + let pred = List.fold_left f Names.Cpred.empty (Classops.coercions ()) in red_flags:= CClosure.RedFlags.red_add_transparent CClosure.betaiotazeta - (Names.Id.Pred.full,Names.Cpred.complement !predref) + (Names.Id.Pred.full,Names.Cpred.complement pred) let ground_tac solver startseq = Proofview.Goal.enter begin fun gl -> diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml index 439274240f..ad11f853ca 100644 --- a/plugins/funind/invfun.ml +++ b/plugins/funind/invfun.ml @@ -351,7 +351,7 @@ let prove_fun_correct evd funs_constr graphs_constr schemes lemmas_types_infos i Locusops.onConcl); observe_tac ("toto ") tclIDTAC; - (* introducing the the result of the graph and the equality hypothesis *) + (* introducing the result of the graph and the equality hypothesis *) observe_tac "introducing" (tclMAP (fun x -> Proofview.V82.of_tactic (Simple.intro x)) [res;hres]); (* replacing [res] with its value *) observe_tac "rewriting res value" (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar hres))); diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml index 4b834d66d3..636cb8ebf8 100644 --- a/plugins/ltac/tacentries.ml +++ b/plugins/ltac/tacentries.ml @@ -594,15 +594,6 @@ let rec clause_of_sign : type a. a ty_sig -> Genarg.ArgT.any Extend.user_symbol let clause_of_ty_ml = function | TyML (t,_) -> clause_of_sign t -let rec prj : type a b c. (a,b,c) Extend.ty_user_symbol -> (a,b,c) genarg_type = function - | TUentry a -> ExtraArg a - | TUentryl (a,l) -> ExtraArg a - | TUopt(o) -> OptArg (prj o) - | TUlist1 l -> ListArg (prj l) - | TUlist1sep (l,_) -> ListArg (prj l) - | TUlist0 l -> ListArg (prj l) - | TUlist0sep (l,_) -> ListArg (prj l) - let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic = fun sign tac -> match sign with @@ -617,7 +608,7 @@ let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Geninterp.i begin fun tac vals ist -> match vals with | [] -> assert false | v :: vals -> - let v' = Taccoerce.Value.cast (topwit (prj a)) v in + let v' = Taccoerce.Value.cast (topwit (Egramml.proj_symbol a)) v in f (tac v') vals ist end tac | TyAnonArg (a, sig') -> eval_sign sig' tac diff --git a/plugins/ltac/tacenv.mli b/plugins/ltac/tacenv.mli index 7143f51853..d5d36c97fa 100644 --- a/plugins/ltac/tacenv.mli +++ b/plugins/ltac/tacenv.mli @@ -41,7 +41,7 @@ val register_alias : alias -> alias_tactic -> unit (** Register a tactic alias. *) val interp_alias : alias -> alias_tactic -(** Recover the the body of an alias. Raises an anomaly if it does not exist. *) +(** Recover the body of an alias. Raises an anomaly if it does not exist. *) val check_alias : alias -> bool (** Returns [true] if an alias is defined, false otherwise. *) diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml index 54f3f9c718..1f3c758e5c 100644 --- a/plugins/ssr/ssrcommon.ml +++ b/plugins/ssr/ssrcommon.ml @@ -469,7 +469,7 @@ let ssrevaltac ist gtac = Tacinterp.tactic_of_value ist gtac (* term mkApp (t', args) is convertible to t. *) (* This makes a useful shorthand for local definitions in proofs, *) (* i.e., pose succ := _ + 1 means pose succ := fun n : nat => n + 1, *) -(* and, in context of the the 4CT library, pose mid := maps id means *) +(* and, in context of the 4CT library, pose mid := maps id means *) (* pose mid := fun d : detaSet => @maps d d (@id (datum d)) *) (* Note that this facility does not extend to set, which tries *) (* instead to fill holes by matching a goal subterm. *) diff --git a/plugins/ssr/ssrvernac.ml4 b/plugins/ssr/ssrvernac.ml4 index 7ce2dd64af..989a6c5bf1 100644 --- a/plugins/ssr/ssrvernac.ml4 +++ b/plugins/ssr/ssrvernac.ml4 @@ -24,7 +24,6 @@ open Ltac_plugin open Notation_ops open Notation_term open Glob_term -open Globnames open Stdarg open Genarg open Decl_kinds @@ -218,8 +217,8 @@ let interp_search_notation ?loc tag okey = (Bytes.set s' i' '_'; loop (j + 1) (i' + 2)) else (String.blit s i s' i' m; loop (j + 1) (i' + m + 1)) in loop 0 1 in - let trim_ntn (pntn, m) = Bytes.sub_string pntn 1 (max 0 m) in - let pr_ntn ntn = str "(" ++ str ntn ++ str ")" in + let trim_ntn (pntn, m) = (InConstrEntrySomeLevel,Bytes.sub_string pntn 1 (max 0 m)) in + let pr_ntn ntn = str "(" ++ Notation.pr_notation ntn ++ str ")" in let pr_and_list pr = function | [x] -> pr x | x :: lx -> pr_list pr_comma pr lx ++ pr_comma () ++ str "and " ++ pr x @@ -294,7 +293,7 @@ let interp_search_notation ?loc tag okey = let scs' = List.remove (=) sc !scs in let w = pr_ntn ntn ++ str " is also defined " ++ pr_scs scs' in Feedback.msg_warning (hov 4 w) - else if String.string_contains ~where:ntn ~what:" .. " then + else if String.string_contains ~where:(snd ntn) ~what:" .. " then err (pr_ntn ntn ++ str " is an n-ary notation"); let nvars = List.filter (fun (_,(_,typ)) -> typ = NtnTypeConstr) nvars in let rec sub () = function @@ -359,13 +358,12 @@ let coerce_search_pattern_to_sort hpat = true, cp with _ -> false, [] in let coerce hp coe_index = - let coe = Classops.get_coercion_value coe_index in + let coe_ref = coe_index.Classops.coe_value in try - let coe_ref = global_of_constr coe in let n_imps = Option.get (Classops.hide_coercion coe_ref) in mkPApp (Pattern.PRef coe_ref) n_imps [|hp|] - with _ -> - errorstrm (str "need explicit coercion " ++ pr_constr_env env sigma coe ++ spc () + with Not_found | Option.IsNone -> + errorstrm (str "need explicit coercion " ++ pr_global coe_ref ++ spc () ++ str "to interpret head search pattern as type") in filter_head, List.fold_left coerce hpat' coe_path diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml index 05eda14e90..30a998c6ce 100644 --- a/plugins/ssrmatching/ssrmatching.ml +++ b/plugins/ssrmatching/ssrmatching.ml @@ -929,7 +929,7 @@ let glob_cpattern gs p = | k, (v, Some t), _ as orig -> if k = 'x' then glob_ssrterm gs ('(', (v, Some t), None) else match t.CAst.v with - | CNotation("( _ in _ )", ([t1; t2], [], [], [])) -> + | CNotation((InConstrEntrySomeLevel,"( _ in _ )"), ([t1; t2], [], [], [])) -> (try match glob t1, glob t2 with | (r1, None), (r2, None) -> encode k "In" [r1;r2] | (r1, Some _), (r2, Some _) when isCVar t1 -> @@ -937,11 +937,11 @@ let glob_cpattern gs p = | (r1, Some _), (r2, Some _) -> encode k "In" [r1; r2] | _ -> CErrors.anomaly (str"where are we?.") with _ when isCVar t1 -> encode k "In" [bind_in t1 t2]) - | CNotation("( _ in _ in _ )", ([t1; t2; t3], [], [], [])) -> + | CNotation((InConstrEntrySomeLevel,"( _ in _ in _ )"), ([t1; t2; t3], [], [], [])) -> check_var t2; encode k "In" [fst (glob t1); bind_in t2 t3] - | CNotation("( _ as _ )", ([t1; t2], [], [], [])) -> + | CNotation((InConstrEntrySomeLevel,"( _ as _ )"), ([t1; t2], [], [], [])) -> encode k "As" [fst (glob t1); fst (glob t2)] - | CNotation("( _ as _ in _ )", ([t1; t2; t3], [], [], [])) -> + | CNotation((InConstrEntrySomeLevel,"( _ as _ in _ )"), ([t1; t2; t3], [], [], [])) -> check_var t2; encode k "As" [fst (glob t1); bind_in t2 t3] | _ -> glob_ssrterm gs orig ;; diff --git a/pretyping/cases.ml b/pretyping/cases.ml index 6a63fb02f8..ad33297f0a 100644 --- a/pretyping/cases.ml +++ b/pretyping/cases.ml @@ -373,6 +373,11 @@ let ltac_interp_realnames lvar = function | t, IsInd (ty,ind,realnal) -> t, IsInd (ty,ind,List.map (ltac_interp_name lvar) realnal) | _ as x -> x +let is_patvar pat = + match DAst.get pat with + | PatVar _ -> true + | _ -> false + let coerce_row typing_fun evdref env lvar pats (tomatch,(na,indopt)) = let loc = loc_of_glob_constr tomatch in let tycon,realnames = find_tomatch_tycon evdref env loc indopt in @@ -381,6 +386,7 @@ let coerce_row typing_fun evdref env lvar pats (tomatch,(na,indopt)) = let typ = nf_evar !evdref j.uj_type in lvar := make_return_predicate_ltac_lvar !evdref na tomatch j.uj_val !lvar; let t = + if realnames = None && pats <> [] && List.for_all is_patvar pats then NotInd (None,typ) else try try_find_ind env !evdref typ realnames with Not_found -> unify_tomatch_with_patterns evdref env loc typ pats realnames in diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml index 3758008189..da6e26cc4b 100644 --- a/pretyping/cbv.ml +++ b/pretyping/cbv.ml @@ -280,8 +280,9 @@ let rec norm_head info env t stack = | Var id -> norm_head_ref 0 info env stack (VarKey id) | Const sp -> - Reductionops.reduction_effect_hook (env_of_infos info.infos) info.sigma t (lazy (reify_stack t stack)); - norm_head_ref 0 info env stack (ConstKey sp) + Reductionops.reduction_effect_hook (env_of_infos info.infos) info.sigma + (fst sp) (lazy (reify_stack t stack)); + norm_head_ref 0 info env stack (ConstKey sp) | LetIn (_, b, _, c) -> (* zeta means letin are contracted; delta without zeta means we *) diff --git a/pretyping/classops.ml b/pretyping/classops.ml index 7ac08e755e..542fb5456c 100644 --- a/pretyping/classops.ml +++ b/pretyping/classops.ml @@ -42,18 +42,15 @@ type coe_typ = GlobRef.t module CoeTypMap = Refmap_env type coe_info_typ = { - coe_value : constr; - coe_type : types; + coe_value : GlobRef.t; coe_local : bool; - coe_context : Univ.ContextSet.t; coe_is_identity : bool; coe_is_projection : Projection.Repr.t option; - coe_param : int } + coe_param : int; +} let coe_info_typ_equal c1 c2 = - let eq_constr c1 c2 = Termops.eq_constr Evd.empty (EConstr.of_constr c1) (EConstr.of_constr c2) in - eq_constr c1.coe_value c2.coe_value && - eq_constr c1.coe_type c2.coe_type && + GlobRef.equal c1.coe_value c2.coe_value && c1.coe_local == c2.coe_local && c1.coe_is_identity == c2.coe_is_identity && c1.coe_is_projection == c2.coe_is_projection && @@ -77,9 +74,7 @@ module IntMap = Map.Make(Int) let cl_typ_eq t1 t2 = Int.equal (cl_typ_ord t1 t2) 0 -type coe_index = coe_info_typ - -type inheritance_path = coe_index list +type inheritance_path = coe_info_typ list (* table des classes, des coercions et graphe d'heritage *) @@ -300,31 +295,25 @@ let lookup_path_to_fun_from env sigma s = let lookup_path_to_sort_from env sigma s = apply_on_class_of env sigma s lookup_path_to_sort_from_class +let mkNamed = function + | GlobRef.ConstRef c -> EConstr.mkConst c + | VarRef v -> EConstr.mkVar v + | ConstructRef c -> EConstr.mkConstruct c + | IndRef i -> EConstr.mkInd i + let get_coercion_constructor env coe = - let c, _ = - Reductionops.whd_all_stack env Evd.empty (EConstr.of_constr coe.coe_value) - in - match EConstr.kind Evd.empty (** FIXME *) c with - | Construct (cstr,u) -> - (cstr, Inductiveops.constructor_nrealargs cstr -1) - | _ -> - raise Not_found + let evd = Evd.from_env env in + let red x = fst (Reductionops.whd_all_stack env evd x) in + match EConstr.kind evd (red (mkNamed coe.coe_value)) with + | Constr.Construct (c, _) -> + c, Inductiveops.constructor_nrealargs c -1 + | _ -> raise Not_found let lookup_pattern_path_between env (s,t) = let i = inductive_class_of s in let j = inductive_class_of t in List.map (get_coercion_constructor env) (ClPairMap.find (i,j) !inheritance_graph) -(* coercion_value : coe_index -> unsafe_judgment * bool *) - -let coercion_value { coe_value = c; coe_type = t; coe_context = ctx; - coe_is_identity = b; coe_is_projection = b' } = - let subst, ctx = UnivGen.fresh_universe_context_set_instance ctx in - let c' = Vars.subst_univs_level_constr subst c - and t' = Vars.subst_univs_level_constr subst t in - (make_judge (EConstr.of_constr c') (EConstr.of_constr t'), b, b'), ctx - -(* pretty-print functions are now in Pretty *) (* rajouter une coercion dans le graphe *) let path_printer : (env -> Evd.evar_map -> (Bijint.Index.t * Bijint.Index.t) * inheritance_path -> Pp.t) ref = @@ -442,17 +431,13 @@ let cache_coercion env sigma (_, c) = let () = add_class c.coercion_target in let is, _ = class_info c.coercion_source in let it, _ = class_info c.coercion_target in - let value, ctx = UnivGen.fresh_global_instance env c.coercion_type in - let typ = Retyping.get_type_of env sigma (EConstr.of_constr value) in - let typ = EConstr.Unsafe.to_constr typ in let xf = - { coe_value = value; - coe_type = typ; - coe_context = ctx; + { coe_value = c.coercion_type; coe_local = c.coercion_local; coe_is_identity = c.coercion_is_id; coe_is_projection = c.coercion_is_proj; - coe_param = c.coercion_params } in + coe_param = c.coercion_params; + } in let () = add_new_coercion c.coercion_type xf in add_coercion_in_graph env sigma (xf,is,it) @@ -531,8 +516,6 @@ let declare_coercion coef ?(local = false) ~isid ~src:cls ~target:clt ~params:ps Lib.add_anonymous_leaf (inCoercion c) (* For printing purpose *) -let get_coercion_value v = v.coe_value - let pr_cl_index = Bijint.Index.print let classes () = Bijint.dom !class_tab diff --git a/pretyping/classops.mli b/pretyping/classops.mli index 8df085e15c..af00c0a8dc 100644 --- a/pretyping/classops.mli +++ b/pretyping/classops.mli @@ -39,16 +39,19 @@ type cl_info_typ = { type coe_typ = GlobRef.t (** This is the type of infos for declared coercions *) -type coe_info_typ +type coe_info_typ = { + coe_value : GlobRef.t; + coe_local : bool; + coe_is_identity : bool; + coe_is_projection : Projection.Repr.t option; + coe_param : int; +} (** [cl_index] is the type of class keys *) type cl_index -(** [coe_index] is the type of coercion keys *) -type coe_index - (** This is the type of paths from a class to another *) -type inheritance_path = coe_index list +type inheritance_path = coe_info_typ list (** {6 Access to classes infos } *) @@ -79,8 +82,6 @@ val declare_coercion : (** {6 Access to coercions infos } *) val coercion_exists : coe_typ -> bool -val coercion_value : coe_index -> (unsafe_judgment * bool * Projection.Repr.t option) Univ.in_universe_context_set - (** {6 Lookup functions for coercion paths } *) (** @raise Not_found in the following functions when no path exists *) @@ -105,10 +106,9 @@ val install_path_printer : val string_of_class : cl_typ -> string val pr_class : cl_typ -> Pp.t val pr_cl_index : cl_index -> Pp.t -val get_coercion_value : coe_index -> Constr.t val inheritance_graph : unit -> ((cl_index * cl_index) * inheritance_path) list val classes : unit -> cl_typ list -val coercions : unit -> coe_index list +val coercions : unit -> coe_info_typ list (** [hide_coercion] returns the number of params to skip if the coercion must be hidden, [None] otherwise; it raises [Not_found] if not a coercion *) diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml index c6c2f57dd4..5e3821edf1 100644 --- a/pretyping/coercion.ml +++ b/pretyping/coercion.ml @@ -369,8 +369,11 @@ let apply_coercion env sigma p hj typ_cl = let j,t,evd = List.fold_left (fun (ja,typ_cl,sigma) i -> - let ((fv,isid,isproj),ctx) = coercion_value i in - let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in + let isid = i.coe_is_identity in + let isproj = i.coe_is_projection in + let sigma, c = new_global sigma i.coe_value in + let typ = Retyping.get_type_of env sigma c in + let fv = make_judge c typ in let argl = (class_args_of env sigma typ_cl)@[ja.uj_val] in let sigma, jres = apply_coercion_args env sigma true isproj argl fv diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml index b379cdf410..ec0ff73062 100644 --- a/pretyping/inductiveops.ml +++ b/pretyping/inductiveops.ml @@ -633,7 +633,7 @@ let is_predicate_explicitly_dep env sigma pred arsign = dependency status (of course, Anonymous implies non dependent, but not conversely). - From Coq > 8.2, using or not the the effective dependency of + From Coq > 8.2, using or not the effective dependency of the predicate is parametrable! *) begin match na with diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index 63c7ab3c69..ba40262815 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -47,29 +47,28 @@ open Libobject type effect_name = string (** create a persistent set to store effect functions *) -module ConstrMap = Map.Make (Constr) (* Table bindings a constant to an effect *) -let constant_effect_table = Summary.ref ~name:"reduction-side-effect" ConstrMap.empty +let constant_effect_table = Summary.ref ~name:"reduction-side-effect" Cmap.empty (* Table bindings function key to effective functions *) let effect_table = Summary.ref ~name:"reduction-function-effect" String.Map.empty (** a test to know whether a constant is actually the effect function *) -let reduction_effect_hook env sigma termkey c = +let reduction_effect_hook env sigma con c = try - let funkey = ConstrMap.find termkey !constant_effect_table in + let funkey = Cmap.find con !constant_effect_table in let effect = String.Map.find funkey !effect_table in effect env sigma (Lazy.force c) with Not_found -> () -let cache_reduction_effect (_,(termkey,funkey)) = - constant_effect_table := ConstrMap.add termkey funkey !constant_effect_table +let cache_reduction_effect (_,(con,funkey)) = + constant_effect_table := Cmap.add con funkey !constant_effect_table -let subst_reduction_effect (subst,(termkey,funkey)) = - (subst_mps subst termkey,funkey) +let subst_reduction_effect (subst,(con,funkey)) = + (subst_constant subst con,funkey) -let inReductionEffect : Constr.constr * string -> obj = +let inReductionEffect : Constant.t * string -> obj = declare_object {(default_object "REDUCTION-EFFECT") with cache_function = cache_reduction_effect; open_function = (fun i o -> if Int.equal i 1 then cache_reduction_effect o); @@ -83,8 +82,7 @@ let declare_reduction_effect funkey f = (** A function to set the value of the print function *) let set_reduction_effect x funkey = - let termkey = UnivGen.constr_of_global x in - Lib.add_anonymous_leaf (inReductionEffect (termkey,funkey)) + Lib.add_anonymous_leaf (inReductionEffect (x,funkey)) (** Machinery to custom the behavior of the reduction *) @@ -872,7 +870,7 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma = | Some body -> whrec cst_l (body, stack) | None -> fold ()) | Const (c,u as const) -> - reduction_effect_hook env sigma (EConstr.to_constr sigma x) + reduction_effect_hook env sigma c (lazy (EConstr.to_constr sigma (Stack.zip sigma (x,stack)))); if CClosure.RedFlags.red_set flags (CClosure.RedFlags.fCONST c) then let u' = EInstance.kind sigma u in diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli index b44c642d43..07eeec9276 100644 --- a/pretyping/reductionops.mli +++ b/pretyping/reductionops.mli @@ -41,10 +41,10 @@ val declare_reduction_effect : effect_name -> (Environ.env -> Evd.evar_map -> Constr.constr -> unit) -> unit (* [set_reduction_effect cst name] declares effect [name] to be called when [cst] is found *) -val set_reduction_effect : GlobRef.t -> effect_name -> unit +val set_reduction_effect : Constant.t -> effect_name -> unit (* [effect_hook env sigma key term] apply effect associated to [key] on [term] *) -val reduction_effect_hook : Environ.env -> Evd.evar_map -> Constr.constr -> +val reduction_effect_hook : Environ.env -> Evd.evar_map -> Constant.t -> Constr.constr Lazy.t -> unit (** {6 Machinery about a stack of unfolded constant } diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index 599a0f8162..8911a2f343 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -539,7 +539,7 @@ let reduce_mind_case_use_function func env sigma mia = let match_eval_ref env sigma constr stack = match EConstr.kind sigma constr with | Const (sp, u) -> - reduction_effect_hook env sigma (EConstr.to_constr sigma constr) + reduction_effect_hook env sigma sp (lazy (EConstr.to_constr sigma (applist (constr,stack)))); if is_evaluable env (EvalConstRef sp) then Some (EvalConst sp, u) else None | Var id when is_evaluable env (EvalVarRef id) -> Some (EvalVar id, EInstance.empty) @@ -550,7 +550,7 @@ let match_eval_ref env sigma constr stack = let match_eval_ref_value env sigma constr stack = match EConstr.kind sigma constr with | Const (sp, u) -> - reduction_effect_hook env sigma (EConstr.to_constr sigma constr) + reduction_effect_hook env sigma sp (lazy (EConstr.to_constr sigma (applist (constr,stack)))); if is_evaluable env (EvalConstRef sp) then let u = EInstance.kind sigma u in @@ -558,8 +558,6 @@ let match_eval_ref_value env sigma constr stack = else None | Proj (p, c) when not (Projection.unfolded p) -> - reduction_effect_hook env sigma (EConstr.to_constr ~abort_on_undefined_evars:false sigma constr) - (lazy (EConstr.to_constr sigma (applist (constr,stack)))); if is_evaluable env (EvalConstRef (Projection.constant p)) then Some (mkProj (Projection.unfold p, c)) else None diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml index c944080503..255707dc7b 100644 --- a/pretyping/vnorm.ml +++ b/pretyping/vnorm.ml @@ -209,6 +209,9 @@ and nf_evar env sigma evk stk = | Zapp args :: stk -> (** We assume that there is no consecutive Zapp nodes in a VM stack. Is that really an invariant? *) + (** Let-bound arguments are present in the evar arguments but not in the + type, so we turn the let into a product. *) + let hyps = Context.Named.drop_bodies hyps in let fold accu d = Term.mkNamedProd_or_LetIn d accu in let t = List.fold_left fold concl hyps in let t, args = nf_args env sigma args t in diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index e38da45b95..418e13759b 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -295,7 +295,7 @@ let tag_var = tag Tag.variable | CPatOr pl -> hov 0 (prlist_with_sep pr_spcbar (pr_patt mt (lpator,L)) pl), lpator - | CPatNotation ("( _ )",([p],[]),[]) -> + | CPatNotation ((_,"( _ )"),([p],[]),[]) -> pr_patt (fun()->str"(") (max_int,E) p ++ str")", latom | CPatNotation (s,(l,ll),args) -> @@ -665,7 +665,7 @@ let tag_var = tag Tag.variable | CastCoerce -> str ":>"), lcast ) - | CNotation ("( _ )",([t],[],[],[])) -> + | CNotation ((_,"( _ )"),([t],[],[],[])) -> return (pr (fun()->str"(") (max_int,L) t ++ str")", latom) | CNotation (s,env) -> pr_notation (pr mt) pr_patt (pr_binders_gen (pr mt ltop)) s env diff --git a/printing/prettyp.ml b/printing/prettyp.ml index fd7135b6a6..1810cc6588 100644 --- a/printing/prettyp.ml +++ b/printing/prettyp.ml @@ -98,7 +98,8 @@ let print_ref reduce ref udecl = (Array.to_list (Univ.Instance.to_array inst)) udecl in let sigma = Evd.from_ctx (UState.of_binders bl) in let inst = - if Global.is_polymorphic ref then Printer.pr_universe_instance sigma univs + if Global.is_polymorphic ref + then Printer.pr_universe_instance sigma (Univ.UContext.instance univs) else mt () in hov 0 (pr_global ref ++ inst ++ str " :" ++ spc () ++ pr_letype_env env sigma typ ++ @@ -552,8 +553,7 @@ let print_instance sigma cb = if Declareops.constant_is_polymorphic cb then let univs = Declareops.constant_polymorphic_context cb in let inst = Univ.AUContext.instance univs in - let univs = Univ.UContext.make (inst, Univ.AUContext.instantiate inst univs) in - pr_universe_instance sigma univs + pr_universe_instance sigma inst else mt() let print_constant with_values sep sp udecl = @@ -657,14 +657,10 @@ let gallina_print_library_entry env sigma with_values ent = gallina_print_leaf_entry env sigma with_values (oname,lobj) | (oname,Lib.OpenedSection (dir,_)) -> Some (str " >>>>>>> Section " ++ pr_name oname) - | (oname,Lib.ClosedSection _) -> - Some (str " >>>>>>> Closed Section " ++ pr_name oname) | (_,Lib.CompilingLibrary { obj_dir; _ }) -> Some (str " >>>>>>> Library " ++ DirPath.print obj_dir) | (oname,Lib.OpenedModule _) -> Some (str " >>>>>>> Module " ++ pr_name oname) - | (oname,Lib.ClosedModule _) -> - Some (str " >>>>>>> Closed Module " ++ pr_name oname) let gallina_print_context env sigma with_values = let rec prec n = function @@ -793,9 +789,6 @@ let read_sec_context qid = let rec get_cxt in_cxt = function | (_,Lib.OpenedSection ({obj_dir;_},_) as hd)::rest -> if DirPath.equal dir obj_dir then (hd::in_cxt) else get_cxt (hd::in_cxt) rest - | (_,Lib.ClosedSection _)::rest -> - user_err Pp.(str "Cannot print the contents of a closed section.") - (* LEM: Actually, we could if we wanted to. *) | [] -> [] | hd::rest -> get_cxt (hd::in_cxt) rest in @@ -909,7 +902,7 @@ let inspect env sigma depth = open Classops -let print_coercion_value env sigma v = pr_lconstr_env env sigma (get_coercion_value v) +let print_coercion_value env sigma v = Printer.pr_global v.coe_value let print_class i = let cl,_ = class_info_from_index i in diff --git a/printing/printer.ml b/printing/printer.ml index ba094596ff..5b3ead181f 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -82,11 +82,10 @@ let pr_econstr_n_core goal_concl_style env sigma n t = pr_constr_expr_n n (extern_constr goal_concl_style env sigma t) let pr_econstr_core goal_concl_style env sigma t = pr_constr_expr (extern_constr goal_concl_style env sigma t) -let pr_leconstr_core goal_concl_style env sigma t = - pr_lconstr_expr (extern_constr goal_concl_style env sigma t) +let pr_leconstr_core = Proof_diffs.pr_leconstr_core let pr_constr_n_env env sigma n c = pr_econstr_n_core false env sigma n (EConstr.of_constr c) -let pr_lconstr_env env sigma c = pr_leconstr_core false env sigma (EConstr.of_constr c) +let pr_lconstr_env = Proof_diffs.pr_lconstr_env let pr_constr_env env sigma c = pr_econstr_core false env sigma (EConstr.of_constr c) let _ = Hook.set Refine.pr_constr pr_constr_env @@ -133,8 +132,7 @@ let pr_lconstr_under_binders c = let pr_etype_core goal_concl_style env sigma t = pr_constr_expr (extern_type goal_concl_style env sigma t) -let pr_letype_core goal_concl_style env sigma t = - pr_lconstr_expr (extern_type goal_concl_style env sigma t) +let pr_letype_core = Proof_diffs.pr_letype_core let pr_ltype_env env sigma c = pr_letype_core false env sigma (EConstr.of_constr c) let pr_type_env env sigma c = pr_etype_core false env sigma (EConstr.of_constr c) @@ -290,11 +288,13 @@ let pr_cumulativity_info sigma cumi = let pr_global_env = pr_global_env let pr_global = pr_global_env Id.Set.empty -let pr_puniverses f env (c,u) = - f env c ++ - (if !Constrextern.print_universes then - str"(*" ++ Univ.Instance.pr UnivNames.pr_with_global_universes u ++ str"*)" - else mt ()) +let pr_universe_instance evd inst = + str"@{" ++ Univ.Instance.pr (Termops.pr_evd_level evd) inst ++ str"}" + +let pr_puniverses f env sigma (c,u) = + if !Constrextern.print_universes + then f env c ++ pr_universe_instance sigma u + else f env c let pr_constant env cst = pr_global_env (Termops.vars_of_env env) (ConstRef cst) let pr_existential_key = Termops.pr_existential_key @@ -1016,10 +1016,6 @@ let pr_polymorphic b = if b then str"Polymorphic " else str"Monomorphic " else mt () -let pr_universe_instance evd ctx = - let inst = Univ.UContext.instance ctx in - str"@{" ++ Univ.Instance.pr (Termops.pr_evd_level evd) inst ++ str"}" - (* print the proof step, possibly with diffs highlighted, *) let print_and_diff oldp newp = match newp with diff --git a/printing/printer.mli b/printing/printer.mli index 948b06f3f6..971241d5f9 100644 --- a/printing/printer.mli +++ b/printing/printer.mli @@ -120,7 +120,7 @@ val pr_sort : evar_map -> Sorts.t -> Pp.t val pr_polymorphic : bool -> Pp.t val pr_cumulative : bool -> bool -> Pp.t -val pr_universe_instance : evar_map -> Univ.UContext.t -> Pp.t +val pr_universe_instance : evar_map -> Univ.Instance.t -> Pp.t val pr_universe_ctx : evar_map -> ?variance:Univ.Variance.t array -> Univ.UContext.t -> Pp.t val pr_universe_ctx_set : evar_map -> Univ.ContextSet.t -> Pp.t @@ -139,9 +139,9 @@ val pr_constructor : env -> constructor -> Pp.t val pr_inductive : env -> inductive -> Pp.t val pr_evaluable_reference : evaluable_global_reference -> Pp.t -val pr_pconstant : env -> pconstant -> Pp.t -val pr_pinductive : env -> pinductive -> Pp.t -val pr_pconstructor : env -> pconstructor -> Pp.t +val pr_pconstant : env -> evar_map -> pconstant -> Pp.t +val pr_pinductive : env -> evar_map -> pinductive -> Pp.t +val pr_pconstructor : env -> evar_map -> pconstructor -> Pp.t (** Contexts *) diff --git a/printing/printmod.ml b/printing/printmod.ml index 3f95dcfb6d..e2d9850bf8 100644 --- a/printing/printmod.ml +++ b/printing/printmod.ml @@ -103,9 +103,7 @@ let print_one_inductive env sigma mib ((_,i) as ind) = let envpar = push_rel_context params env in let inst = if Declareops.inductive_is_polymorphic mib then - let ctx = Declareops.inductive_polymorphic_context mib in - let ctx = Univ.UContext.make (u, Univ.AUContext.instantiate u ctx) in - Printer.pr_universe_instance sigma ctx + Printer.pr_universe_instance sigma u else mt () in hov 0 ( diff --git a/printing/proof_diffs.ml b/printing/proof_diffs.ml index 7131ced15b..3a81e908a7 100644 --- a/printing/proof_diffs.ml +++ b/printing/proof_diffs.ml @@ -251,6 +251,11 @@ let pr_letype_core goal_concl_style env sigma t = let pp_of_type env sigma ty = pr_letype_core true env sigma EConstr.(of_constr ty) +let pr_leconstr_core goal_concl_style env sigma t = + Ppconstr.pr_lconstr_expr (Constrextern.extern_constr goal_concl_style env sigma t) + +let pr_lconstr_env env sigma c = pr_leconstr_core false env sigma (EConstr.of_constr c) + (* fetch info from a goal, returning (idents, map, concl_pp) where idents is a list with one entry for each hypothesis, each entry is the list of idents on the lhs of the hypothesis. map is a map from ident to hyp_info @@ -278,10 +283,13 @@ let goal_info goal sigma = line_idents := idents :: !line_idents; let mid = match body with - | Some x -> str " := " ++ pp_of_type env sigma ty ++ str " : " - | None -> str " : " in + | Some c -> + let pb = pr_lconstr_env env sigma c in + let pb = if Constr.isCast c then surround pb else pb in + str " := " ++ pb + | None -> mt() in let ts = pp_of_type env sigma ty in - let rhs_pp = mid ++ ts in + let rhs_pp = mid ++ str " : " ++ ts in let make_entry () = { idents; rhs_pp; done_ = false } in List.iter (fun ident -> map := (StringMap.add ident (make_entry ()) !map); ()) idents diff --git a/printing/proof_diffs.mli b/printing/proof_diffs.mli index 0d3b5821e5..482f03b686 100644 --- a/printing/proof_diffs.mli +++ b/printing/proof_diffs.mli @@ -30,6 +30,8 @@ val diff_first_goal : Proof.t option -> Proof.t option -> Pp.t list * Pp.t open Evd open Proof_type +open Environ +open Constr (** Computes the diff between two goals @@ -46,6 +48,10 @@ val diff_goals : ?prev_gs:(goal sigma) -> goal sigma option -> Pp.t (** Convert a string to a list of token strings using the lexer *) val tokenize_string : string -> string list +val pr_letype_core : bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Pp.t +val pr_leconstr_core : bool -> Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t +val pr_lconstr_env : env -> evar_map -> constr -> Pp.t + (* Exposed for unit test, don't use these otherwise *) (* output channel for the test log file *) val log_out_ch : out_channel ref diff --git a/proofs/proof.ml b/proofs/proof.ml index 51e0a1d614..0d355890c5 100644 --- a/proofs/proof.ml +++ b/proofs/proof.ml @@ -63,6 +63,7 @@ exception CannotUnfocusThisWay (* Cannot focus on non-existing subgoals *) exception NoSuchGoals of int * int +exception NoSuchGoal of Names.Id.t exception FullyUnfocused @@ -75,6 +76,10 @@ let _ = CErrors.register_handler begin function CErrors.user_err ~hdr:"Focus" Pp.( str"Not every goal in range ["++ int i ++ str","++int j++str"] exist." ) + | NoSuchGoal id -> + CErrors.user_err + ~hdr:"Focus" + Pp.(str "No such goal: " ++ str (Names.Id.to_string id) ++ str ".") | FullyUnfocused -> CErrors.user_err Pp.(str "The proof is not focused") | _ -> raise CErrors.Unhandled end @@ -230,6 +235,37 @@ let focus cond inf i pr = try _focus cond (Obj.repr inf) i i pr with CList.IndexOutOfRange -> raise (NoSuchGoals (i,i)) +(* Focus on the goal named id *) +let focus_id cond inf id pr = + let (focused_goals, evar_map) = Proofview.proofview pr.proofview in + begin match try Some (Evd.evar_key id evar_map) with Not_found -> None with + | Some ev -> + begin match CList.safe_index Evar.equal ev focused_goals with + | Some i -> + (* goal is already under focus *) + _focus cond (Obj.repr inf) i i pr + | None -> + if CList.mem_f Evar.equal ev pr.shelf then + (* goal is on the shelf, put it in focus *) + let proofview = Proofview.unshelve [ev] pr.proofview in + let shelf = + CList.filter (fun ev' -> Evar.equal ev ev' |> not) pr.shelf + in + let pr = { pr with proofview; shelf } in + let (focused_goals, _) = Proofview.proofview pr.proofview in + let i = + (* Now we know that this will succeed *) + try CList.index Evar.equal ev focused_goals + with Not_found -> assert false + in + _focus cond (Obj.repr inf) i i pr + else + raise CannotUnfocusThisWay + end + | None -> + raise (NoSuchGoal id) + end + let rec unfocus kind pr () = let cond = cond_of_focus pr in match test_cond cond kind pr.proofview with diff --git a/proofs/proof.mli b/proofs/proof.mli index c0e832fb8c..33addf13d7 100644 --- a/proofs/proof.mli +++ b/proofs/proof.mli @@ -137,6 +137,9 @@ val done_cond : ?loose_end:bool -> 'a focus_kind -> 'a focus_condition a need for it? *) val focus : 'a focus_condition -> 'a -> int -> t -> t +(* focus on goal named id *) +val focus_id : 'aa focus_condition -> 'a -> Names.Id.t -> t -> t + exception FullyUnfocused exception CannotUnfocusThisWay diff --git a/stm/stm.ml b/stm/stm.ml index e15b6048ba..2e9bf71e49 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -1103,7 +1103,8 @@ module Backtrack : sig val branches_of : Stateid.t -> backup (* Returns the state that the command should backtract to *) - val undo_vernac_classifier : vernac_control -> Stateid.t * vernac_when + val undo_vernac_classifier : vernac_control -> doc:doc -> Stateid.t * vernac_when + val get_prev_proof : doc:doc -> Stateid.t -> Proof.t option end = struct (* {{{ *) @@ -1161,7 +1162,17 @@ end = struct (* {{{ *) " If your use is intentional, you may want to disable this warning and pass" ^ " the \"-async-proofs-cache force\" option to Coq.")) - let undo_vernac_classifier v = + let back_tactic n (id,_,_,tactic,undo) = + let value = (if tactic then 1 else 0) - undo in + if Int.equal n 0 then `Stop id else `Cont (n-value) + + let get_proof ~doc id = + let open Vernacstate in + match state_of_id ~doc id with + | `Valid (Some vstate) -> Some (Proof_global.proof_of_state vstate.proof) + | _ -> None + + let undo_vernac_classifier v ~doc = if VCS.is_interactive () = `No && !cur_opt.async_proofs_cache <> Some Force then undo_costly_in_batch_mode v; try @@ -1185,9 +1196,7 @@ end = struct (* {{{ *) oid, VtNow | VernacUndo n -> let id = VCS.get_branch_pos (VCS.current_branch ()) in - let oid = fold_until (fun n (id,_,_,tactic,undo) -> - let value = (if tactic then 1 else 0) - undo in - if Int.equal n 0 then `Stop id else `Cont (n-value)) n id in + let oid = fold_until back_tactic n id in oid, VtLater | VernacUndoTo _ | VernacRestart as e -> @@ -1220,8 +1229,16 @@ end = struct (* {{{ *) CErrors.user_err ~hdr:"undo_vernac_classifier" Pp.(str "Cannot undo") + let get_prev_proof ~doc id = + try + let did = fold_until back_tactic 1 id in + get_proof ~doc did + with Not_found -> None + end (* }}} *) +let get_prev_proof = Backtrack.get_prev_proof + let hints = ref Aux_file.empty_aux_file let set_compilation_hints file = hints := Aux_file.load_aux_file_for file @@ -2785,7 +2802,7 @@ let process_transaction ~doc ?(newtip=Stateid.fresh ()) match c with (* Meta *) | VtMeta, _ -> - let id, w = Backtrack.undo_vernac_classifier expr in + let id, w = Backtrack.undo_vernac_classifier expr ~doc in process_back_meta_command ~newtip ~head id x w (* Query *) diff --git a/stm/stm.mli b/stm/stm.mli index 50e7f06095..7f70ea18da 100644 --- a/stm/stm.mli +++ b/stm/stm.mli @@ -110,6 +110,10 @@ val add : doc:doc -> ontop:Stateid.t -> ?newtip:Stateid.t -> bool -> Vernacexpr.vernac_control CAst.t -> doc * Stateid.t * [ `NewTip | `Unfocus of Stateid.t ] +(* Returns the proof state before the last tactic that was applied at or before +the specified state. Used to compute proof diffs. *) +val get_prev_proof : doc:doc -> Stateid.t -> Proof.t option + (* [query at ?report_with cmd] Executes [cmd] at a given state [at], throwing away side effects except messages. Feedback will be sent with [report_with], which defaults to the dummy state id *) diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml index 6be80d29a5..2170477938 100644 --- a/stm/vernac_classifier.ml +++ b/stm/vernac_classifier.ml @@ -42,13 +42,6 @@ let string_of_vernac_when = function let string_of_vernac_classification (t,w) = string_of_vernac_type t ^ " " ^ string_of_vernac_when w -let classifiers = ref [] -let declare_vernac_classifier - (s : Vernacexpr.extend_name) - (f : Genarg.raw_generic_argument list -> unit -> vernac_classification) -= - classifiers := !classifiers @ [s,f] - let idents_of_name : Names.Name.t -> Names.Id.t list = function | Names.Anonymous -> [] @@ -162,6 +155,7 @@ let classify_vernac e = | VernacDeclareClass _ | VernacDeclareInstances _ | VernacRegister _ | VernacNameSectionHypSet _ + | VernacDeclareCustomEntry _ | VernacComments _ -> VtSideff [], VtLater (* Who knows *) | VernacLoad _ -> VtSideff [], VtNow @@ -194,7 +188,7 @@ let classify_vernac e = | VernacWriteState _ -> VtSideff [], VtNow (* Plugins should classify their commands *) | VernacExtend (s,l) -> - try List.assoc s !classifiers l () + try Vernacentries.get_vernac_classifier s l with Not_found -> anomaly(str"No classifier for"++spc()++str (fst s)++str".") in let rec static_control_classifier ~poly = function diff --git a/stm/vernac_classifier.mli b/stm/vernac_classifier.mli index 45fbfb42af..e82b191418 100644 --- a/stm/vernac_classifier.mli +++ b/stm/vernac_classifier.mli @@ -9,17 +9,12 @@ (************************************************************************) open Vernacexpr -open Genarg val string_of_vernac_classification : vernac_classification -> string (** What does a vernacular do *) val classify_vernac : vernac_control -> vernac_classification -(** Install a vernacular classifier for VernacExtend *) -val declare_vernac_classifier : - Vernacexpr.extend_name -> (raw_generic_argument list -> unit -> vernac_classification) -> unit - (** Standard constant classifiers *) val classify_as_query : vernac_classification val classify_as_sideeff : vernac_classification diff --git a/stm/workerLoop.mli b/stm/workerLoop.mli deleted file mode 100644 index 37ec6dacca..0000000000 --- a/stm/workerLoop.mli +++ /dev/null @@ -1,16 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) -(* <O___,, * (see CREDITS file for the list of authors) *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(* * (see LICENSE file for the text of the license) *) -(************************************************************************) - -(* Default priority *) -val async_proofs_worker_priority : CoqworkmgrApi.priority ref - -val loop : - (unit -> unit) -> Coqargs.coq_cmdopts -> string list -> - Coqargs.coq_cmdopts * string list diff --git a/tactics/hints.ml b/tactics/hints.ml index 09b2e59cea..43a450ea71 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -886,20 +886,6 @@ let pr_hint_term env sigma ctx = function let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in pr_econstr_env env sigma c -(** We need an object to record the side-effect of registering - global universes associated with a hint. *) -let cache_context_set (_,c) = - Global.push_context_set false c - -let input_context_set : Univ.ContextSet.t -> Libobject.obj = - let open Libobject in - declare_object - { (default_object "Global universe context") with - cache_function = cache_context_set; - load_function = (fun _ -> cache_context_set); - discharge_function = (fun (_,a) -> Some a); - classify_function = (fun a -> Keep a) } - let warn_polymorphic_hint = CWarnings.create ~name:"polymorphic-hint" ~category:"automation" (fun hint -> strbrk"Using polymorphic hint " ++ hint ++ @@ -919,7 +905,7 @@ let fresh_global_or_constr env sigma poly cr = else begin if isgr then warn_polymorphic_hint (pr_hint_term env sigma ctx cr); - Lib.add_anonymous_leaf (input_context_set ctx); + Declare.declare_universe_context false ctx; (c, Univ.ContextSet.empty) end @@ -1315,7 +1301,7 @@ let prepare_hint check (poly,local) env init (sigma,c) = let diff = Univ.ContextSet.diff (Evd.universe_context_set sigma) (Evd.universe_context_set init) in if poly then IsConstr (c', diff) else if local then IsConstr (c', diff) - else (Lib.add_anonymous_leaf (input_context_set diff); + else (Declare.declare_universe_context false diff; IsConstr (c', Univ.ContextSet.empty)) let project_hint ~poly pri l2r r = diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 5fc34619e8..2a8ebe08ca 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -5063,6 +5063,7 @@ let constr_eq ~strict x y = let unify ?(state=full_transparent_state) x y = Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in let sigma = Proofview.Goal.sigma gl in try let core_flags = @@ -5078,7 +5079,7 @@ let unify ?(state=full_transparent_state) x y = let sigma = w_unify (Tacmach.New.pf_env gl) sigma Reduction.CONV ~flags x y in Proofview.Unsafe.tclEVARS sigma with e when CErrors.noncritical e -> - Tacticals.New.tclFAIL 0 (str"Not unifiable") + Proofview.tclZERO (PretypeError (env, sigma, CannotUnify (x, y, None))) end module Simple = struct diff --git a/test-suite/Makefile b/test-suite/Makefile index 33b4023272..b8aac8b6f8 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -192,10 +192,6 @@ PRINT_LOGS?= TRAVIS?= # special because we want to print travis_fold directives ifdef APPVEYOR PRINT_LOGS:=APPVEYOR -else -ifdef CIRCLECI -PRINT_LOGS:=CIRCLECI -endif #CIRCLECI endif #APPVEYOR report: summary.log diff --git a/test-suite/bugs/closed/2733.v b/test-suite/bugs/closed/2733.v index 832de4f913..24dd30b32e 100644 --- a/test-suite/bugs/closed/2733.v +++ b/test-suite/bugs/closed/2733.v @@ -16,6 +16,21 @@ match k,l with |B,l' => Bcons true (Ncons 0 l') end. +(* At some time, the success of trullynul was dependent on the name of + the variables! *) + +Definition trullynul2 k {a} (l : alt_list k a) := +match k,l with + |N,l' => Ncons 0 (Bcons true l') + |B,l' => Bcons true (Ncons 0 l') +end. + +Definition trullynul3 k {z} (l : alt_list k z) := +match k,l with + |N,l' => Ncons 0 (Bcons true l') + |B,l' => Bcons true (Ncons 0 l') +end. + Fixpoint app (P : forall {k k'}, alt_list k k' -> alt_list k k') {t1 t2} (l : alt_list t1 t2) {struct l}: forall {t3}, alt_list t2 t3 -> alt_list t1 t3 := match l with diff --git a/test-suite/bugs/closed/4202.v b/test-suite/bugs/closed/4202.v new file mode 100644 index 0000000000..522a3604a3 --- /dev/null +++ b/test-suite/bugs/closed/4202.v @@ -0,0 +1,10 @@ +Parameter g : nat -> Prop. +Axiom a : forall n, g (S n). +Lemma foo (H : True) : exists n, g n /\ g n. +eexists. +clear H. +split. +simple apply a. +(* goal is "g (S ?Goal0@ {H:=H})" while H has long ceased to exist *) +simpl. +Abort. diff --git a/test-suite/bugs/closed/8119.v b/test-suite/bugs/closed/8119.v new file mode 100644 index 0000000000..c6329a7328 --- /dev/null +++ b/test-suite/bugs/closed/8119.v @@ -0,0 +1,46 @@ +Require Import Coq.Strings.String. + +Section T. + Eval vm_compute in let x := tt in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval vm_compute in let _ := Set in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval vm_compute in let _ := Prop in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End T. + +Section U0. + Let n : unit := tt. + Eval vm_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End U0. + +Section S0. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval vm_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End S0. + +Class T := { }. +Section S1. + Context {p : T}. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval vm_compute in _. +(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) +End S1. + +Class M := { m : Type }. +Section S2. + Context {p : M}. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval vm_compute in _. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) +End S2. diff --git a/test-suite/bugs/closed/8126.v b/test-suite/bugs/closed/8126.v new file mode 100644 index 0000000000..f52dfc6b47 --- /dev/null +++ b/test-suite/bugs/closed/8126.v @@ -0,0 +1,13 @@ +(* See also output test Notations4.v *) + +Inductive foo := tt. +Bind Scope foo_scope with foo. +Delimit Scope foo_scope with foo. +Notation "'HI'" := tt : foo_scope. +Definition myfoo (x : nat) (y : nat) (z : foo) := y. +Notation myfoo0 := (@myfoo 0). +Notation myfoo01 := (@myfoo0 1). +Check myfoo 0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 tt. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 HI. (* was failing *) diff --git a/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired index 56815d241e..72c520218c 100644 --- a/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired +++ b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired @@ -1,6 +1,6 @@ After | File Name | Before || Change | % Change -------------------------------------------------------- -0m00.38s | Total | 0m00.39s || -0m00.01s | -2.56% +0m00.34s | Total | 0m00.49s || -0m00.14s | -30.61% -------------------------------------------------------- -0m00.35s | Slow | 0m00.02s || +0m00.32s | +1649.99% -0m00.03s | Fast | 0m00.37s || -0m00.34s | -91.89%
\ No newline at end of file +0m00.32s | Fast | 0m00.02s || +0m00.30s | +1500.00% +0m00.02s | Slow | 0m00.47s || -0m00.44s | -95.74%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired index 18f0f34b28..74dad73332 100644 --- a/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired +++ b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired @@ -1,9 +1,9 @@ -After | Code | Before || Change | % Change ---------------------------------------------------------------------------------------------------- -0m00.50s | Total | 0m04.17s || -0m03.66s | -87.96% ---------------------------------------------------------------------------------------------------- -0m00.145s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.192s || -0m00.04s | -24.47% -0m00.126s | Chars 000 - 026 [Require~Coq.ZArith.BinInt.] | 0m00.143s || -0m00.01s | -11.88% - N/A | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] | 0m00.s || +0m00.00s | N/A -0m00.s | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | N/A || +0m00.00s | N/A -0m00.231s | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m03.836s || -0m03.60s | -93.97%
\ No newline at end of file +After | Code | Before || Change | % Change +---------------------------------------------------------------------------------------------------- +0m04.35s | Total | 0m00.58s || +0m03.77s | +649.05% +---------------------------------------------------------------------------------------------------- +0m03.87s | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m00.246s || +0m03.62s | +1473.17% +0m00.322s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.189s || +0m00.13s | +70.37% +0m00.16s | Chars 000 - 026 [Require~Coq.ZArith.BinInt.] | 0m00.146s || +0m00.01s | +9.58% +0m00.s | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] | N/A || +0m00.00s | N/A + N/A | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | 0m00.s || +0m00.00s | N/A
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/run.sh b/test-suite/coq-makefile/timing/run.sh index 6737197ee4..78a3f7c63a 100755 --- a/test-suite/coq-makefile/timing/run.sh +++ b/test-suite/coq-makefile/timing/run.sh @@ -5,6 +5,10 @@ set -e . ../template/path-init.sh +# reset MAKEFLAGS so that, e.g., `make -C test-suite -B coq-makefile` doesn't give us issues + +MAKEFLAGS= + cd precomputed-time-tests ./run.sh || exit $? diff --git a/test-suite/coqdoc/links.html.out b/test-suite/coqdoc/links.html.out index 5e4b676c2f..d2d4d5d764 100644 --- a/test-suite/coqdoc/links.html.out +++ b/test-suite/coqdoc/links.html.out @@ -60,32 +60,32 @@ Various checks for coqdoc <span class="id" title="keyword">Definition</span> <a name="f"><span class="id" title="definition">f</span></a> := <span class="id" title="keyword">∀</span> <span class="id" title="var">C</span>:<span class="id" title="keyword">Prop</span>, <a class="idref" href="Coqdoc.links.html#C"><span class="id" title="variable">C</span></a>.<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/> +<span class="id" title="keyword">Notation</span> <a name="f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). +<span class="id" title="keyword">Notation</span> <a name="f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). <br/> -<span class="id" title="keyword">Notation</span> <a name="6b97e27793a3d22f5c0d1dd63170fd68"><span class="id" title="notation">"</span></a>n ** m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> +<span class="id" title="keyword">Notation</span> <a name="f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">"</span></a>n ** m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="3e01fbae4590c7b7699ff99ce61580e1"><span class="id" title="notation">"</span></a>n ▵ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> +<span class="id" title="keyword">Notation</span> <a name="a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">"</span></a>n ▵ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">"</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/> +<span class="id" title="keyword">Notation</span> <a name="3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">"</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/> <br/> -<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#d43e996736952df71ebeeae74d10a287"><span class="id" title="notation">→</span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:></span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/> +<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#1c93e43e07fbeaeb6a625cb6614beb5d"><span class="id" title="notation">→</span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/> <br/> -<span class="id" title="keyword">where</span> <a name="8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">"</span></a>x = y :> A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="inductive">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/> +<span class="id" title="keyword">where</span> <a name="b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">"</span></a>x = y :> A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="inductive">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:></span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a name="eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">"</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/> +<span class="id" title="keyword">Notation</span> <a name="2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">"</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#6b97e27793a3d22f5c0d1dd63170fd68"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">))</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a name="9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">))</span></a>.<br/> <br/> <span class="id" title="keyword">Notation</span> <a name="h"><span class="id" title="abbreviation">h</span></a> := <a class="idref" href="Coqdoc.links.html#a"><span class="id" title="definition">a</span></a>.<br/> @@ -97,7 +97,7 @@ Various checks for coqdoc <span class="id" title="keyword">Variables</span> <a name="test.b'"><span class="id" title="variable">b'</span></a> <a name="test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> - <span class="id" title="keyword">Notation</span> <a name="4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">"</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#3e01fbae4590c7b7699ff99ce61580e1"><span class="id" title="notation">▵</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/> + <span class="id" title="keyword">Notation</span> <a name="2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">"</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">▵</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/> <br/> <span class="id" title="keyword">Delimit</span> <span class="id" title="keyword">Scope</span> <span class="id" title="var">my_scope</span> <span class="id" title="keyword">with</span> <span class="id" title="var">my</span>.<br/> @@ -106,19 +106,19 @@ Various checks for coqdoc <span class="id" title="keyword">Notation</span> <a name="l"><span class="id" title="abbreviation">l</span></a> := 0.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/> + <span class="id" title="keyword">Definition</span> <a name="ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="a'"><span class="id" title="definition">a'</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> + <span class="id" title="keyword">Definition</span> <a name="a'"><span class="id" title="definition">a'</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}</span></a>.<br/> + <span class="id" title="keyword">Definition</span> <a name="c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/> + <span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/> <br/> - <span class="id" title="keyword">Lemma</span> <a name="e"><span class="id" title="lemma">e</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#3dcaec3b772747610227247939f96b01"><span class="id" title="notation">+</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + <span class="id" title="keyword">Lemma</span> <a name="e"><span class="id" title="lemma">e</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e03f39daf98516fa530d3f6f5a1b4d92"><span class="id" title="notation">+</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <span class="id" title="var">Admitted</span>.<br/> <br/> @@ -137,7 +137,7 @@ Various checks for coqdoc <span class="id" title="keyword">Variables</span> <a name="test2.test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="a''"><span class="id" title="definition">a''</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/> + <span class="id" title="keyword">Definition</span> <a name="a''"><span class="id" title="definition">a''</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/> <br/> <span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test2.test"><span class="id" title="section">test</span></a>.<br/> diff --git a/test-suite/coqdoc/links.tex.out b/test-suite/coqdoc/links.tex.out index f42db99dc2..24f96ff1e6 100644 --- a/test-suite/coqdoc/links.tex.out +++ b/test-suite/coqdoc/links.tex.out @@ -51,34 +51,34 @@ Various checks for coqdoc \coqdockw{Definition} \coqdef{Coqdoc.links.f}{f}{\coqdocdefinition{f}} := \coqdockw{\ensuremath{\forall}} \coqdocvar{C}:\coqdockw{Prop}, \coqdocvariable{C}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x '++' x}{"}{"}n ++ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{mult}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{mult}} \coqdocvar{n} \coqdocvar{m}). \coqdocemptyline +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x '++' x}{"}{"}n ++ m" := (\coqexternalref{mult}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{mult}} \coqdocvar{n} \coqdocvar{m}). \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x '**' x}{"}{"}n ** m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x '**' x}{"}{"}n ** m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x 'xE2x96xB5' x}{"}{"}n ▵ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x 'xE2x96xB5' x}{"}{"}n ▵ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x ''' ''' '++' 'x' x}{"}{"}n '\_' ++ 'x' m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 3).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x ''' ''' '++' 'x' x}{"}{"}n '\_' ++ 'x' m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 3).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdocvar{A}:\coqdockw{Type}) (\coqdocvar{x}:\coqdocvariable{A}) : \coqdocvar{A} \coqexternalref{:type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqdocvariable{A}\coqdoceol +\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdocvar{A}:\coqdockw{Type}) (\coqdocvar{x}:\coqdocvariable{A}) : \coqdocvar{A} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqdocvariable{x} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqdocvariable{x} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqdocvariable{A}\coqdoceol \coqdocnoindent \coqdoceol \coqdocnoindent -\coqdockw{where} \coqdef{Coqdoc.links.:type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqref{Coqdoc.links.eq}{\coqdocinductive{eq}} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol +\coqdockw{where} \coqdef{Coqdoc.links.::type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqref{Coqdoc.links.eq}{\coqdocinductive{eq}} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Definition} \coqdef{Coqdoc.links.eq0}{eq0}{\coqdocdefinition{eq0}} := 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.eq0}{eq0}{\coqdocdefinition{eq0}} := 0 \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{=}} 0 \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{:>}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{"}{"}( x \# y ; .. ; z )" := (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} .. (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} \coqdocvar{x} \coqdocvar{y}) .. \coqdocvar{z}).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{"}{"}( x \# y ; .. ; z )" := (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} .. (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} \coqdocvar{x} \coqdocvar{y}) .. \coqdocvar{z}).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Definition} \coqdef{Coqdoc.links.b xCExB1}{b\_α}{\coqdocdefinition{b\_α}} := \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{(}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{\#}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{;}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{)}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{,}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}0 \coqref{Coqdoc.links.::x '**' x}{\coqdocnotation{**}} 0\coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{))}}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.b xCExB1}{b\_α}{\coqdocdefinition{b\_α}} := \coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{(}}0\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{\#}}0\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{;}}0\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{)}} \coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{,}} \coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}0 \coqref{Coqdoc.links.:::x '**' x}{\coqdocnotation{**}} 0\coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{))}}.\coqdoceol \coqdocemptyline \coqdocnoindent \coqdockw{Notation} \coqdef{Coqdoc.links.h}{h}{\coqdocabbreviation{h}} := \coqref{Coqdoc.links.a}{\coqdocdefinition{a}}.\coqdoceol @@ -90,7 +90,7 @@ Various checks for coqdoc \coqdockw{Variables} \coqdef{Coqdoc.links.test.b'}{b'}{\coqdocvariable{b'}} \coqdef{Coqdoc.links.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Notation} \coqdef{Coqdoc.links.test.:my scope:x '+' x}{"}{"}n + m" := (\coqdocvar{n} \coqref{Coqdoc.links.::x 'xE2x96xB5' x}{\coqdocnotation{▵}} \coqdocvar{m}) : \coqdocvar{my\_scope}.\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.test.::my scope:x '+' x}{"}{"}n + m" := (\coqdocvar{n} \coqref{Coqdoc.links.:::x 'xE2x96xB5' x}{\coqdocnotation{▵}} \coqdocvar{m}) : \coqdocvar{my\_scope}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} \coqdockw{Delimit} \coqdockw{Scope} \coqdocvar{my\_scope} \coqdockw{with} \coqdocvar{my}.\coqdoceol @@ -99,19 +99,19 @@ Various checks for coqdoc \coqdockw{Notation} \coqdef{Coqdoc.links.l}{l}{\coqdocabbreviation{l}} := 0.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.xCExB1}{α}{\coqdocdefinition{α}} := (0 \coqref{Coqdoc.links.test.:my scope:x '+' x}{\coqdocnotation{+}} \coqref{Coqdoc.links.l}{\coqdocabbreviation{l}})\%\coqdocvar{my}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.xCExB1}{α}{\coqdocdefinition{α}} := (0 \coqref{Coqdoc.links.test.::my scope:x '+' x}{\coqdocnotation{+}} \coqref{Coqdoc.links.l}{\coqdocabbreviation{l}})\%\coqdocvar{my}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdocvar{b} := \coqdocvariable{b'}\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}\coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdocvar{b} := \coqdocvariable{b'}\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}\coqdocvariable{b2} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.c}{c}{\coqdocdefinition{c}} := \coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}+\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}}}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.c}{c}{\coqdocdefinition{c}} := \coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}+\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}}}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.d}{d}{\coqdocdefinition{d}} := (1\coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}}2)\%\coqdocvar{nat}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.d}{d}{\coqdocdefinition{d}} := (1\coqexternalref{::nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}}2)\%\coqdocvar{nat}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Lemma} \coqdef{Coqdoc.links.e}{e}{\coqdoclemma{e}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} \coqexternalref{:type scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{+}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdockw{Lemma} \coqdef{Coqdoc.links.e}{e}{\coqdoclemma{e}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} \coqexternalref{::type scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{+}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocindent{2.00em} \coqdocvar{Admitted}.\coqdoceol \coqdocemptyline @@ -131,7 +131,7 @@ Various checks for coqdoc \coqdockw{Variables} \coqdef{Coqdoc.links.test2.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocemptyline \coqdocindent{3.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdocvar{b} := \coqdocvariable{b'} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b} \coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdocvar{b} := \coqdocvariable{b'} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqdocvariable{b2} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b} \coqexternalref{::nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} \coqdockw{End} \coqref{Coqdoc.links.test2.test}{\coqdocsection{test}}.\coqdoceol diff --git a/test-suite/output/BadOptionValueType.out b/test-suite/output/BadOptionValueType.out new file mode 100644 index 0000000000..34d8518a75 --- /dev/null +++ b/test-suite/output/BadOptionValueType.out @@ -0,0 +1,8 @@ +The command has indeed failed with message: +Bad type of value for this option: expected int, got string. +The command has indeed failed with message: +Bad type of value for this option: expected bool, got string. +The command has indeed failed with message: +Bad type of value for this option: expected bool, got int. +The command has indeed failed with message: +Bad type of value for this option: expected bool, got int. diff --git a/test-suite/output/BadOptionValueType.v b/test-suite/output/BadOptionValueType.v new file mode 100644 index 0000000000..b61c3757ba --- /dev/null +++ b/test-suite/output/BadOptionValueType.v @@ -0,0 +1,4 @@ +Fail Set Default Timeout "2". +Fail Set Debug Eauto "yes". +Fail Set Debug Eauto 1. +Fail Set Implicit Arguments 1. diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out index 419dcadb4c..dfab400baa 100644 --- a/test-suite/output/Cases.out +++ b/test-suite/output/Cases.out @@ -169,3 +169,5 @@ fun x : K => match x with | _ => 2 end : K -> nat +The command has indeed failed with message: +Pattern "S _, _" is redundant in this clause. diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v index 4740c009a4..e4fa7044e7 100644 --- a/test-suite/output/Cases.v +++ b/test-suite/output/Cases.v @@ -217,3 +217,6 @@ Check fun x => match x with a3 | a4 => 3 | _ => 2 end. Check fun x => match x with a3 => 3 | a2 | a1 => 4 | _ => 2 end. Check fun x => match x with a4 => 3 | a2 | a1 => 4 | _ => 2 end. Check fun x => match x with a3 | a4 | a1 => 3 | _ => 2 end. + +(* Test redundant clause within a disjunctive pattern *) +Fail Check fun n m => match n, m with 0, 0 | _, S _ | S 0, _ | S (S _ | _), _ => false end. diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out index 5ab616160a..d32cf67e28 100644 --- a/test-suite/output/Notations3.out +++ b/test-suite/output/Notations3.out @@ -246,3 +246,9 @@ Notation ============================ ##@% ^^^ +myfoo01 tt + : nat +myfoo01 tt + : nat +myfoo01 tt + : nat diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v index 876aaa3944..180e8d337e 100644 --- a/test-suite/output/Notations3.v +++ b/test-suite/output/Notations3.v @@ -399,3 +399,14 @@ Show. Abort. End Issue7731. + +Module Issue8126. + +Definition myfoo (x : nat) (y : nat) (z : unit) := y. +Notation myfoo0 := (@myfoo 0). +Notation myfoo01 := (@myfoo0 1). +Check myfoo 0 1 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo0 1 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) + +End Issue8126. diff --git a/test-suite/output/Notations4.out b/test-suite/output/Notations4.out new file mode 100644 index 0000000000..cef7d1a702 --- /dev/null +++ b/test-suite/output/Notations4.out @@ -0,0 +1,17 @@ +[< 0 > + < 1 > * < 2 >] + : nat +[<< # 0 >>] + : option nat +[1 {f 1}] + : Expr +fun (x : nat) (y z : Expr) => [1 + y z + {f x}] + : nat -> Expr -> Expr -> Expr +fun e : Expr => +match e with +| [x y + z] => [x + y z] +| [1 + 1] => [1] +| _ => [e + e] +end + : Expr -> Expr +[(1 + 1)] + : Expr diff --git a/test-suite/output/Notations4.v b/test-suite/output/Notations4.v new file mode 100644 index 0000000000..9738ce5a5e --- /dev/null +++ b/test-suite/output/Notations4.v @@ -0,0 +1,68 @@ +(* An example with constr subentries *) + +Module A. + +Declare Custom Entry myconstr. + +Notation "[ x ]" := x (x custom myconstr at level 6). +Notation "x + y" := (Nat.add x y) (in custom myconstr at level 5). +Notation "x * y" := (Nat.mul x y) (in custom myconstr at level 4). +Notation "< x >" := x (in custom myconstr at level 3, x constr at level 10). +Check [ < 0 > + < 1 > * < 2 >]. + +Declare Custom Entry anotherconstr. + +Notation "[ x ]" := x (x custom myconstr at level 6). +Notation "<< x >>" := x (in custom myconstr at level 3, x custom anotherconstr at level 10). +Notation "# x" := (Some x) (in custom anotherconstr at level 8, x constr at level 9). +Check [ << # 0 >> ]. + +End A. + +Module B. + +Inductive Expr := + | Mul : Expr -> Expr -> Expr + | Add : Expr -> Expr -> Expr + | One : Expr. + +Declare Custom Entry expr. +Notation "[ expr ]" := expr (expr custom expr at level 2). +Notation "1" := One (in custom expr at level 0). +Notation "x y" := (Mul x y) (in custom expr at level 1, left associativity). +Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). +Notation "( x )" := x (in custom expr at level 0, x at level 2). +Notation "{ x }" := x (in custom expr at level 0, x constr). +Notation "x" := x (in custom expr at level 0, x ident). + +Axiom f : nat -> Expr. +Check [1 {f 1}]. +Check fun x y z => [1 + y z + {f x}]. +Check fun e => match e with +| [x y + z] => [x + y z] +| [1 + 1] => [1] +| y => [y + e] +end. + +End B. + +Module C. + +Inductive Expr := + | Add : Expr -> Expr -> Expr + | One : Expr. + +Declare Custom Entry expr. +Notation "[ expr ]" := expr (expr custom expr at level 1). +Notation "1" := One (in custom expr at level 0). +Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). +Notation "( x )" := x (in custom expr at level 0, x at level 2). + +(* Check the use of a two-steps coercion from constr to expr 1 then + from expr 0 to expr 2 (note that camlp5 parsing is more tolerant + and does not require parentheses to parse from level 2 while at + level 1) *) + +Check [1 + 1]. + +End C. diff --git a/test-suite/output/ssr_explain_match.out b/test-suite/output/ssr_explain_match.out index fa2393b910..32cfb354bf 100644 --- a/test-suite/output/ssr_explain_match.out +++ b/test-suite/output/ssr_explain_match.out @@ -1,35 +1,35 @@ File "stdin", line 12, characters 0-61: -Warning: Notation _ - _ was already used in scope nat_scope. +Warning: Notation "_ - _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ <= _ was already used in scope nat_scope. +Warning: Notation "_ <= _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ < _ was already used in scope nat_scope. +Warning: Notation "_ < _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ >= _ was already used in scope nat_scope. +Warning: Notation "_ >= _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ > _ was already used in scope nat_scope. +Warning: Notation "_ > _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ <= _ <= _ was already used in scope nat_scope. +Warning: Notation "_ <= _ <= _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ < _ <= _ was already used in scope nat_scope. +Warning: Notation "_ < _ <= _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ <= _ < _ was already used in scope nat_scope. +Warning: Notation "_ <= _ < _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ < _ < _ was already used in scope nat_scope. +Warning: Notation "_ < _ < _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ + _ was already used in scope nat_scope. +Warning: Notation "_ + _" was already used in scope nat_scope. [notation-overridden,parsing] File "stdin", line 12, characters 0-61: -Warning: Notation _ * _ was already used in scope nat_scope. +Warning: Notation "_ * _" was already used in scope nat_scope. [notation-overridden,parsing] BEGIN INSTANCES instance: (x + y + z) matches: (x + y + z) diff --git a/test-suite/success/BracketsWithGoalSelector.v b/test-suite/success/BracketsWithGoalSelector.v index ed035f5213..2f7425bce6 100644 --- a/test-suite/success/BracketsWithGoalSelector.v +++ b/test-suite/success/BracketsWithGoalSelector.v @@ -14,3 +14,12 @@ Proof. Fail Qed. } Qed. + +Lemma foo (n: nat) (P : nat -> Prop): + P n. +Proof. + intros. + refine (nat_ind _ ?[Base] ?[Step] _). + [Base]: { admit. } + [Step]: { admit. } +Abort. diff --git a/test-suite/success/Notations2.v b/test-suite/success/Notations2.v index 7c2cf3ee52..1b33863e3b 100644 --- a/test-suite/success/Notations2.v +++ b/test-suite/success/Notations2.v @@ -126,3 +126,31 @@ Notation "'myexists' x , p" := (ex (fun x => p)) (at level 200, x ident, p at level 200, right associativity) : type_scope. Check myexists I, I = 0. (* Should not be seen as a constructor *) End M14. + +(* 15. Testing different ways to give the same levels without failing *) + +Module M15. + Local Notation "###### x" := (S x) (right associativity, at level 79, x at next level). + Fail Local Notation "###### x" := (S x) (right associativity, at level 79). + Local Notation "###### x" := (S x) (at level 79). +End M15. + +(* 16. Some test about custom entries *) +Module M16. + (* Test locality *) + Local Declare Custom Entry foo. + Fail Notation "#" := 0 (in custom foo). (* Should be local *) + Local Notation "#" := 0 (in custom foo). + + (* Test import *) + Module A. + Declare Custom Entry foo2. + End A. + Fail Notation "##" := 0 (in custom foo2). + Import A. + Local Notation "##" := 0 (in custom foo2). + + (* Test Print Grammar *) + Print Grammar foo. + Print Grammar foo2. +End M16. diff --git a/theories/FSets/FSetAVL.v b/theories/FSets/FSetAVL.v index 3c9b6b428b..dcaea894eb 100644 --- a/theories/FSets/FSetAVL.v +++ b/theories/FSets/FSetAVL.v @@ -15,7 +15,7 @@ It follows the implementation from Ocaml's standard library, All operations given here expect and produce well-balanced trees - (in the ocaml sense: heigths of subtrees shouldn't differ by more + (in the ocaml sense: heights of subtrees shouldn't differ by more than 2), and hence has low complexities (e.g. add is logarithmic in the size of the set). But proving these balancing preservations is in fact not necessary for ensuring correct operational behavior diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v index 56844f4773..59b2f789ab 100644 --- a/theories/FSets/FSetEqProperties.v +++ b/theories/FSets/FSetEqProperties.v @@ -333,7 +333,7 @@ Proof. auto with set. Qed. -(* caracterisation of [union] via [subset] *) +(* characterisation of [union] via [subset] *) Lemma union_subset_1: subset s (union s s')=true. Proof. @@ -408,7 +408,7 @@ intros; apply equal_1; apply inter_add_2. rewrite not_mem_iff; auto. Qed. -(* caracterisation of [union] via [subset] *) +(* characterisation of [union] via [subset] *) Lemma inter_subset_1: subset (inter s s') s=true. Proof. diff --git a/theories/MSets/MSetEqProperties.v b/theories/MSets/MSetEqProperties.v index 1ee098cb07..4f2fdcf94c 100644 --- a/theories/MSets/MSetEqProperties.v +++ b/theories/MSets/MSetEqProperties.v @@ -333,7 +333,7 @@ Proof. auto with set. Qed. -(* caracterisation of [union] via [subset] *) +(* characterisation of [union] via [subset] *) Lemma union_subset_1: subset s (union s s')=true. Proof. @@ -408,7 +408,7 @@ intros; apply equal_1; apply inter_add_2. rewrite not_mem_iff; auto. Qed. -(* caracterisation of [union] via [subset] *) +(* characterisation of [union] via [subset] *) Lemma inter_subset_1: subset (inter s s') s=true. Proof. diff --git a/theories/MSets/MSetGenTree.v b/theories/MSets/MSetGenTree.v index 9d2a73ed0f..95868861fa 100644 --- a/theories/MSets/MSetGenTree.v +++ b/theories/MSets/MSetGenTree.v @@ -13,7 +13,7 @@ This module factorizes common parts in implementations of finite sets as AVL trees and as Red-Black trees. The nodes of the trees defined here include an generic information - parameter, that will be the heigth in AVL trees and the color + parameter, that will be the height in AVL trees and the color in Red-Black trees. Without more details here about these information parameters, trees here are not known to be well-balanced, but simply binary-search-trees. diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v index 3ccaa7211a..68a98e4292 100644 --- a/theories/NArith/Ndigits.v +++ b/theories/NArith/Ndigits.v @@ -517,6 +517,23 @@ Definition N2Bv (n:N) : Bvector (N.size_nat n) := | Npos p => P2Bv p end. +Fixpoint P2Bv_sized (m : nat) (p : positive) : Bvector m := + match m with + | O => [] + | S m => + match p with + | xI p => true :: P2Bv_sized m p + | xO p => false :: P2Bv_sized m p + | xH => true :: Bvect_false m + end + end. + +Definition N2Bv_sized (m : nat) (n : N) : Bvector m := + match n with + | N0 => Bvect_false m + | Npos p => P2Bv_sized m p + end. + Fixpoint Bv2N (n:nat)(bv:Bvector n) : N := match bv with | Vector.nil _ => N0 @@ -670,3 +687,21 @@ rewrite H. destruct a, b, (Bv2N n v1), (Bv2N n v2); simpl; auto. Qed. + +Lemma N2Bv_sized_Nsize (n : N) : + N2Bv_sized (N.size_nat n) n = N2Bv n. +Proof with simpl; auto. + destruct n... + induction p... + all: rewrite IHp... +Qed. + +Lemma N2Bv_sized_Bv2N (n : nat) (v : Bvector n) : + N2Bv_sized n (Bv2N n v) = v. +Proof with simpl; auto. + induction v... + destruct h; + unfold N2Bv_sized; + destruct (Bv2N n v) as [|[]]; + rewrite <- IHv... +Qed. diff --git a/theories/Numbers/Integer/Abstract/ZBits.v b/theories/Numbers/Integer/Abstract/ZBits.v index 2da4452819..4aabda77ee 100644 --- a/theories/Numbers/Integer/Abstract/ZBits.v +++ b/theories/Numbers/Integer/Abstract/ZBits.v @@ -80,7 +80,7 @@ Proof. now apply testbit_even_succ. Qed. -(** Alternative caracterisations of [testbit] *) +(** Alternative characterisations of [testbit] *) (** This concise equation could have been taken as specification for testbit in the interface, but it would have been hard to @@ -102,10 +102,10 @@ Proof. left. destruct b; split; simpl; order'. Qed. -(** This caracterisation that uses only basic operations and +(** This characterisation that uses only basic operations and power was initially taken as specification for testbit. We describe [a] as having a low part and a high part, with - the corresponding bit in the middle. This caracterisation + the corresponding bit in the middle. This characterisation is moderatly complex to implement, but also moderately usable... *) diff --git a/theories/Numbers/Natural/Abstract/NBits.v b/theories/Numbers/Natural/Abstract/NBits.v index e1391f5990..90663de3f2 100644 --- a/theories/Numbers/Natural/Abstract/NBits.v +++ b/theories/Numbers/Natural/Abstract/NBits.v @@ -78,7 +78,7 @@ Proof. apply testbit_even_succ, le_0_l. Qed. -(** Alternative caracterisations of [testbit] *) +(** Alternative characterisations of [testbit] *) (** This concise equation could have been taken as specification for testbit in the interface, but it would have been hard to @@ -99,10 +99,10 @@ Proof. destruct b; order'. Qed. -(** This caracterisation that uses only basic operations and +(** This characterisation that uses only basic operations and power was initially taken as specification for testbit. We describe [a] as having a low part and a high part, with - the corresponding bit in the middle. This caracterisation + the corresponding bit in the middle. This characterisation is moderatly complex to implement, but also moderately usable... *) diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v index 6a3dd97656..9b8dd1db0b 100644 --- a/theories/Reals/Rsqrt_def.v +++ b/theories/Reals/Rsqrt_def.v @@ -392,7 +392,7 @@ Definition cond_positivity (x:R) : bool := | right _ => false end. -(** Sequential caracterisation of continuity *) +(** Sequential characterisation of continuity *) Lemma continuity_seq : forall (f:R -> R) (Un:nat -> R) (l:R), continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l). diff --git a/theories/Structures/GenericMinMax.v b/theories/Structures/GenericMinMax.v index 05edc6ccde..4d04667c01 100644 --- a/theories/Structures/GenericMinMax.v +++ b/theories/Structures/GenericMinMax.v @@ -83,7 +83,7 @@ End GenericMinMax. Module MinMaxLogicalProperties (Import O:TotalOrder')(Import M:HasMinMax O). Module Import Private_Tac := !MakeOrderTac O O. -(** An alternative caracterisation of [max], equivalent to +(** An alternative characterisation of [max], equivalent to [max_l /\ max_r] *) Lemma max_spec n m : diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v index f6f3cafa21..ba3e411091 100644 --- a/theories/Vectors/VectorDef.v +++ b/theories/Vectors/VectorDef.v @@ -312,5 +312,6 @@ Notation "h :: t" := (h :: t) (at level 60, right associativity) Notation "[ x ]" := (x :: []) : vector_scope. Notation "[ x ; y ; .. ; z ]" := (cons _ x _ (cons _ y _ .. (cons _ z _ (nil _)) ..)) : vector_scope. Notation "v [@ p ]" := (nth v p) (at level 1, format "v [@ p ]") : vector_scope. +Infix "++" := append : vector_scope. Open Scope vector_scope. End VectorNotations. diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in index 8b6822a4ed..403ad61798 100644 --- a/tools/CoqMakefile.in +++ b/tools/CoqMakefile.in @@ -343,19 +343,19 @@ make-pretty-timed make-pretty-timed-before make-pretty-timed-after:: print-pretty-timed:: $(HIDE)$(COQMAKE_ONE_TIME_FILE) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) print-pretty-timed-diff:: - $(HIDE)$(COQMAKE_BOTH_TIME_FILES) --sort-by=$(TIMING_SORT_BY) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) + $(HIDE)$(COQMAKE_BOTH_TIME_FILES) --sort-by=$(TIMING_SORT_BY) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) ifeq (,$(BEFORE)) print-pretty-single-time-diff:: - @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff BEFORE=path/to/file.v.before-timing AFTER=path/to/file.v.after-timing' + @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing' $(HIDE)false else ifeq (,$(AFTER)) print-pretty-single-time-diff:: - @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff BEFORE=path/to/file.v.before-timing AFTER=path/to/file.v.after-timing' + @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing' $(HIDE)false else print-pretty-single-time-diff:: - $(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) --sort-by=$(TIMING_SORT_BY) $(BEFORE) $(AFTER) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) + $(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) --sort-by=$(TIMING_SORT_BY) $(AFTER) $(BEFORE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) endif endif pretty-timed: diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml index ad489da822..c3bdf656d1 100644 --- a/tools/coq_makefile.ml +++ b/tools/coq_makefile.ml @@ -31,8 +31,19 @@ let rec print_prefix_list sep = function | x :: l -> print sep; print x; print_prefix_list sep l | [] -> () -let usage_common () = +let usage_coq_makefile () = + output_string stderr "Usage summary:\ +\n\ +\ncoq_makefile .... [file.v] ... [file.ml[i4]?] ... [file.ml{lib,pack}]\ +\n ... [any] ... [-extra[-phony] result dependencies command]\ +\n ... [-I dir] ... [-R physicalpath logicalpath]\ +\n ... [-Q physicalpath logicalpath] ... [VARIABLE = value]\ +\n ... [-arg opt] ... [-opt|-byte] [-no-install] [-f file] [-o file]\ +\n [-h] [--help]\ +\n"; output_string stderr "\ +\nFull list of options:\ +\n\ \n[file.v]: Coq file to be compiled\ \n[file.ml[i4]?]: Objective Caml file to be compiled\ \n[file.ml{lib,pack}]: ocamlbuild file that describes a Objective Caml\ @@ -61,25 +72,6 @@ let usage_common () = \n[-install opt]: where opt is \"user\" to force install into user directory,\ \n \"none\" to build a makefile with no install target or\ \n \"global\" to force install in $COQLIB directory\ -\n" - -let usage_coq_project () = - output_string stderr "Available arguments:"; - usage_common (); - exit 1 - -let usage_coq_makefile () = - output_string stderr "Usage summary:\ -\n\ -\ncoq_makefile .... [file.v] ... [file.ml[i4]?] ... [file.ml{lib,pack}]\ -\n ... [any] ... [-extra[-phony] result dependencies command]\ -\n ... [-I dir] ... [-R physicalpath logicalpath]\ -\n ... [-Q physicalpath logicalpath] ... [VARIABLE = value]\ -\n ... [-arg opt] ... [-opt|-byte] [-no-install] [-f file] [-o file]\ -\n [-h] [--help]\ -\n"; - usage_common (); - output_string stderr "\ \n[-f file]: take the contents of file as arguments\ \n[-o file]: output should go in file file (recommended)\ \n Output file outside the current directory is forbidden.\ @@ -405,7 +397,7 @@ let _ = let project = try cmdline_args_to_project ~curdir:Filename.current_dir_name args - with Parsing_error s -> prerr_endline s; usage_coq_project () in + with Parsing_error s -> prerr_endline s; usage_coq_makefile () in if only_destination <> None then begin destination_of project (Option.get only_destination); diff --git a/tools/coqdoc/index.ml b/tools/coqdoc/index.ml index 885324aa02..724d3838b0 100644 --- a/tools/coqdoc/index.ml +++ b/tools/coqdoc/index.ml @@ -185,7 +185,8 @@ let type_name = function let prepare_entry s = function | Notation -> (* We decode the encoding done in Dumpglob.cook_notation of coqtop *) - (* Encoded notations have the form section:sc:x_'++'_x where: *) + (* Encoded notations have the form section:entry:sc:x_'++'_x *) + (* where: *) (* - the section, if any, ends with a "." *) (* - the scope can be empty *) (* - tokens are separated with "_" *) @@ -202,10 +203,12 @@ let prepare_entry s = function let err () = eprintf "Invalid notation in globalization file\n"; exit 1 in let h = try String.index_from s 0 ':' with _ -> err () in let i = try String.index_from s (h+1) ':' with _ -> err () in - let sc = String.sub s (h+1) (i-h-1) in - let ntn = Bytes.make (String.length s - i) ' ' in + let m = try String.index_from s (i+1) ':' with _ -> err () in + let entry = String.sub s (h+1) (i-h-1) in + let sc = String.sub s (i+1) (m-i-1) in + let ntn = Bytes.make (String.length s - m) ' ' in let k = ref 0 in - let j = ref (i+1) in + let j = ref (m+1) in let quoted = ref false in let l = String.length s - 1 in while !j <= l do @@ -227,7 +230,8 @@ let prepare_entry s = function incr j done; let ntn = Bytes.sub_string ntn 0 !k in - if sc = "" then ntn else ntn ^ " (" ^ sc ^ ")" + let ntn = if sc = "" then ntn else ntn ^ " (" ^ sc ^ ")" in + if entry = "" then ntn else entry ^ ":" ^ ntn | _ -> s diff --git a/toplevel/coqargs.ml b/toplevel/coqargs.ml index 900964609d..113ba3684c 100644 --- a/toplevel/coqargs.ml +++ b/toplevel/coqargs.ml @@ -425,7 +425,7 @@ let parse_args arglist : coq_cmdopts * string list = |"-worker-id" -> set_worker_id opt (next ()); oval |"-compat" -> - let v = G_vernac.parse_compat_version ~allow_old:false (next ()) in + let v = G_vernac.parse_compat_version (next ()) in Flags.compat_version := v; add_compat_require oval v diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml index 7b7e1b16c0..59a464a22e 100644 --- a/toplevel/coqloop.ml +++ b/toplevel/coqloop.ml @@ -330,17 +330,33 @@ let cproof p1 p2 = let drop_last_doc = ref None +(* todo: could add other Set/Unset commands, such as "Printing Universes" *) +let print_anyway_opts = [ + [ "Diffs" ]; + ] + +let print_anyway c = + let open Vernacexpr in + match c with + | VernacExpr (_, VernacSetOption (_, opt, _)) + | VernacExpr (_, VernacUnsetOption (_, opt)) -> + List.mem opt print_anyway_opts + | _ -> false + (* We try to behave better when goal printing raises an exception [usually Ctrl-C] This is mostly a hack as we should protect printing in a more generic way, but that'll do for now *) -let top_goal_print oldp newp = +let top_goal_print ~doc c oldp newp = try let proof_changed = not (Option.equal cproof oldp newp) in - let print_goals = not !Flags.quiet && - proof_changed && Proof_global.there_are_pending_proofs () in - if print_goals then Printer.print_and_diff oldp newp; + let print_goals = proof_changed && Proof_global.there_are_pending_proofs () || + print_anyway c in + if not !Flags.quiet && print_goals then begin + let dproof = Stm.get_prev_proof ~doc (Stm.get_current_state ~doc) in + Printer.print_and_diff dproof newp + end with | exn -> let (e, info) = CErrors.push exn in @@ -376,7 +392,7 @@ let rec vernac_loop ~state = else (Feedback.msg_warning (str "There is no ML toplevel."); vernac_loop ~state) | {v=VernacControl c; loc} -> let nstate = Vernac.process_expr ~state (make ?loc c) in - top_goal_print state.proof nstate.proof; + top_goal_print ~doc:state.doc c state.proof nstate.proof; vernac_loop ~state:nstate with | Stm.End_of_input -> diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml index 9b68f303a6..8cd262c6d6 100644 --- a/toplevel/coqtop.ml +++ b/toplevel/coqtop.ml @@ -362,7 +362,7 @@ let init_color opts = false in if Proof_diffs.show_diffs () && not term_color && not opts.batch_mode then - CErrors.user_err Pp.(str "Error: -diffs requires enabling -color"); + (prerr_endline "Error: -diffs requires enabling -color"; exit 1); Topfmt.init_terminal_output ~color:term_color let print_style_tags opts = @@ -384,7 +384,7 @@ let print_style_tags opts = (** GC tweaking *) (** Coq is a heavy user of persistent data structures and symbolic ASTs, so the - minor heap is heavily sollicited. Unfortunately, the default size is far too + minor heap is heavily solicited. Unfortunately, the default size is far too small, so we enlarge it a lot (128 times larger). To better handle huge memory consumers, we also augment the default major diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml index ee578669c2..e33aa38173 100644 --- a/vernac/auto_ind_decl.ml +++ b/vernac/auto_ind_decl.ml @@ -355,7 +355,7 @@ let destruct_ind sigma c = then avoid should be [| lb_An ... lb _A1 (resp. bl_An ... bl_A1) eq_An .... eq_A1 An ... A1 |] -so from Ai we can find the the correct eq_Ai bl_ai or lb_ai +so from Ai we can find the correct eq_Ai bl_ai or lb_ai *) (* used in the leib -> bool side*) let do_replace_lb mode lb_scheme_key aavoid narg p q = diff --git a/vernac/egramcoq.ml b/vernac/egramcoq.ml index 3281b75aaa..16101396cf 100644 --- a/vernac/egramcoq.ml +++ b/vernac/egramcoq.ml @@ -54,6 +54,17 @@ let default_pattern_levels = let default_constr_levels = (default_levels, default_pattern_levels) +let find_levels levels = function + | InConstrEntry -> levels, String.Map.find "constr" levels + | InCustomEntry s -> + try levels, String.Map.find s levels + with Not_found -> + String.Map.add s ([],[]) levels, ([],[]) + +let save_levels levels custom lev = + let s = match custom with InConstrEntry -> "constr" | InCustomEntry s -> s in + String.Map.add s lev levels + (* At a same level, LeftA takes precedence over RightA and NoneA *) (* In case, several associativity exists for a level, we make two levels, *) (* first LeftA, then RightA and NoneA together *) @@ -125,24 +136,24 @@ let rec list_mem_assoc_triple x = function let register_empty_levels accu forpat levels = let rec filter accu = function | [] -> ([], accu) - | n :: rem -> + | (where,n) :: rem -> let rem, accu = filter accu rem in - let (clev, plev) = accu in + let accu, (clev, plev) = find_levels accu where in let levels = if forpat then plev else clev in if not (list_mem_assoc_triple n levels) then let nlev, ans = find_position_gen levels true None (Some n) in let nlev = if forpat then (clev, nlev) else (nlev, plev) in - ans :: rem, nlev + (where, ans) :: rem, save_levels accu where nlev else rem, accu in filter accu levels -let find_position accu forpat assoc level = - let (clev, plev) = accu in +let find_position accu custom forpat assoc level = + let accu, (clev, plev) = find_levels accu custom in let levels = if forpat then plev else clev in let nlev, ans = find_position_gen levels false assoc level in let nlev = if forpat then (clev, nlev) else (nlev, plev) in - (ans, nlev) + (ans, save_levels accu custom nlev) (**************************************************************************) (* @@ -231,7 +242,7 @@ type (_, _) entry = | TTName : ('self, lname) entry | TTReference : ('self, qualid) entry | TTBigint : ('self, Constrexpr.raw_natural_number) entry -| TTConstr : prod_info * 'r target -> ('r, 'r) entry +| TTConstr : notation_entry * prod_info * 'r target -> ('r, 'r) entry | TTConstrList : prod_info * Tok.t list * 'r target -> ('r, 'r list) entry | TTPattern : int -> ('self, cases_pattern_expr) entry | TTOpenBinderList : ('self, local_binder_expr list) entry @@ -239,17 +250,58 @@ type (_, _) entry = type _ any_entry = TTAny : ('s, 'r) entry -> 's any_entry +let constr_custom_entry : (string, Constrexpr.constr_expr) entry_command = + create_entry_command "constr" (fun s st -> [s], st) +let pattern_custom_entry : (string, Constrexpr.cases_pattern_expr) entry_command = + create_entry_command "pattern" (fun s st -> [s], st) + +let custom_entry_locality = Summary.ref ~name:"LOCAL-CUSTOM-ENTRY" String.Set.empty +(** If the entry is present then local *) + +let create_custom_entry ~local s = + if List.mem s ["constr";"pattern";"ident";"global";"binder";"bigint"] then + user_err Pp.(quote (str s) ++ str " is a reserved entry name."); + let sc = "constr:"^s in + let sp = "pattern:"^s in + let _ = extend_entry_command constr_custom_entry sc in + let _ = extend_entry_command pattern_custom_entry sp in + let () = if local then custom_entry_locality := String.Set.add s !custom_entry_locality in + () + +let find_custom_entry s = + let sc = "constr:"^s in + let sp = "pattern:"^s in + try (find_custom_entry constr_custom_entry sc, find_custom_entry pattern_custom_entry sp) + with Not_found -> user_err Pp.(str "Undeclared custom entry: " ++ str s ++ str ".") + +let locality_of_custom_entry s = String.Set.mem s !custom_entry_locality + (* This computes the name of the level where to add a new rule *) -let interp_constr_entry_key : type r. r target -> int -> r Entry.t * int option = - fun forpat level -> match forpat with +let interp_constr_entry_key : type r. _ -> r target -> int -> r Entry.t * int option = + fun custom forpat level -> + match custom with + | InCustomEntry s -> + (let (entry_for_constr, entry_for_patttern) = find_custom_entry s in + match forpat with + | ForConstr -> entry_for_constr, Some level + | ForPattern -> entry_for_patttern, Some level) + | InConstrEntry -> + match forpat with | ForConstr -> if level = 200 then Constr.binder_constr, None else Constr.operconstr, Some level | ForPattern -> Constr.pattern, Some level -let target_entry : type s. s target -> s Entry.t = function -| ForConstr -> Constr.operconstr -| ForPattern -> Constr.pattern +let target_entry : type s. notation_entry -> s target -> s Entry.t = function +| InConstrEntry -> + (function + | ForConstr -> Constr.operconstr + | ForPattern -> Constr.pattern) +| InCustomEntry s -> + let (entry_for_constr, entry_for_patttern) = find_custom_entry s in + function + | ForConstr -> entry_for_constr + | ForPattern -> entry_for_patttern let is_self from e = match e with | (NumLevel n, BorderProd (Right, _ (* Some(NonA|LeftA) *))) -> false @@ -273,11 +325,11 @@ let make_sep_rules = function let r = mkrule (List.rev tkl) in Arules [r] -let symbol_of_target : type s. _ -> _ -> _ -> s target -> (s, s) symbol = fun p assoc from forpat -> - if is_binder_level from p then Aentryl (target_entry forpat, "200") +let symbol_of_target : type s. _ -> _ -> _ -> _ -> s target -> (s, s) symbol = fun custom p assoc from forpat -> + if custom = InConstrEntry && is_binder_level from p then Aentryl (target_entry InConstrEntry forpat, "200") else if is_self from p then Aself else - let g = target_entry forpat in + let g = target_entry custom forpat in let lev = adjust_level assoc from p in begin match lev with | None -> Aentry g @@ -286,11 +338,11 @@ let symbol_of_target : type s. _ -> _ -> _ -> s target -> (s, s) symbol = fun p end let symbol_of_entry : type s r. _ -> _ -> (s, r) entry -> (s, r) symbol = fun assoc from typ -> match typ with -| TTConstr (p, forpat) -> symbol_of_target p assoc from forpat +| TTConstr (s, p, forpat) -> symbol_of_target s p assoc from forpat | TTConstrList (typ', [], forpat) -> - Alist1 (symbol_of_target typ' assoc from forpat) + Alist1 (symbol_of_target InConstrEntry typ' assoc from forpat) | TTConstrList (typ', tkl, forpat) -> - Alist1sep (symbol_of_target typ' assoc from forpat, make_sep_rules tkl) + Alist1sep (symbol_of_target InConstrEntry typ' assoc from forpat, make_sep_rules tkl) | TTPattern p -> Aentryl (Constr.pattern, string_of_int p) | TTClosedBinderList [] -> Alist1 (Aentry Constr.binder) | TTClosedBinderList tkl -> Alist1sep (Aentry Constr.binder, make_sep_rules tkl) @@ -303,9 +355,8 @@ let interp_entry forpat e = match e with | ETProdName -> TTAny TTName | ETProdReference -> TTAny TTReference | ETProdBigint -> TTAny TTBigint -| ETProdConstr p -> TTAny (TTConstr (p, forpat)) +| ETProdConstr (s,p) -> TTAny (TTConstr (s, p, forpat)) | ETProdPattern p -> TTAny (TTPattern p) -| ETProdOther _ -> assert false (** not used *) | ETProdConstrList (p, tkl) -> TTAny (TTConstrList (p, tkl, forpat)) | ETProdBinderList ETBinderOpen -> TTAny TTOpenBinderList | ETProdBinderList (ETBinderClosed tkl) -> TTAny (TTClosedBinderList tkl) @@ -420,21 +471,23 @@ let target_to_bool : type r. r target -> bool = function | ForConstr -> false | ForPattern -> true -let prepare_empty_levels forpat (pos,p4assoc,name,reinit) = +let prepare_empty_levels forpat (where,(pos,p4assoc,name,reinit)) = let empty = (pos, [(name, p4assoc, [])]) in - if forpat then ExtendRule (Constr.pattern, reinit, empty) - else ExtendRule (Constr.operconstr, reinit, empty) - -let rec pure_sublevels : type a b c. int option -> (a, b, c) rule -> int list = fun level r -> match r with -| Stop -> [] -| Next (rem, Aentryl (_, i)) -> - let i = int_of_string i in - let rem = pure_sublevels level rem in - begin match level with - | Some j when Int.equal i j -> rem - | _ -> i :: rem - end -| Next (rem, _) -> pure_sublevels level rem + ExtendRule (target_entry where forpat, reinit, empty) + +let rec pure_sublevels' custom assoc from forpat level = function +| [] -> [] +| GramConstrNonTerminal (e,_) :: rem -> + let rem = pure_sublevels' custom assoc from forpat level rem in + let push where p rem = + match symbol_of_target custom p assoc from forpat with + | Aentryl (_,i) when level <> Some (int_of_string i) -> (where,int_of_string i) :: rem + | _ -> rem in + (match e with + | ETProdPattern i -> push InConstrEntry (NumLevel i,InternalProd) rem + | ETProdConstr (s,p) -> push s p rem + | _ -> rem) +| (GramConstrTerminal _ | GramConstrListMark _) :: rem -> pure_sublevels' custom assoc from forpat level rem let make_act : type r. r target -> _ -> r gen_eval = function | ForConstr -> fun notation loc env -> @@ -445,17 +498,17 @@ let make_act : type r. r target -> _ -> r gen_eval = function CAst.make ~loc @@ CPatNotation (notation, env, []) let extend_constr state forpat ng = - let n,_,_ = ng.notgram_level in + let custom,n,_,_ = ng.notgram_level in let assoc = ng.notgram_assoc in - let (entry, level) = interp_constr_entry_key forpat n in + let (entry, level) = interp_constr_entry_key custom forpat n in let fold (accu, state) pt = let AnyTyRule r = make_ty_rule assoc n forpat pt in let symbs = ty_erase r in - let pure_sublevels = pure_sublevels level symbs in + let pure_sublevels = pure_sublevels' custom assoc n forpat level pt in let isforpat = target_to_bool forpat in let needed_levels, state = register_empty_levels state isforpat pure_sublevels in - let (pos,p4assoc,name,reinit), state = find_position state isforpat assoc level in - let empty_rules = List.map (prepare_empty_levels isforpat) needed_levels in + let (pos,p4assoc,name,reinit), state = find_position state custom isforpat assoc level in + let empty_rules = List.map (prepare_empty_levels forpat) needed_levels in let empty = { constrs = []; constrlists = []; binders = []; binderlists = [] } in let act = ty_eval r (make_act forpat ng.notgram_notation) empty in let rule = (name, p4assoc, [Rule (symbs, act)]) in @@ -468,7 +521,7 @@ let constr_levels = GramState.field () let extend_constr_notation ng state = let levels = match GramState.get state constr_levels with - | None -> default_constr_levels + | None -> String.Map.add "constr" default_constr_levels String.Map.empty | Some lev -> lev in (* Add the notation in constr *) diff --git a/vernac/egramcoq.mli b/vernac/egramcoq.mli index b0341e6a17..3a6f8ae015 100644 --- a/vernac/egramcoq.mli +++ b/vernac/egramcoq.mli @@ -17,3 +17,6 @@ val extend_constr_grammar : Notation_gram.one_notation_grammar -> unit (** Add a term notation rule to the parsing system. *) + +val create_custom_entry : local:bool -> string -> unit +val locality_of_custom_entry : string -> bool diff --git a/vernac/egramml.ml b/vernac/egramml.ml index 048d4d93a0..c5dedc880e 100644 --- a/vernac/egramml.ml +++ b/vernac/egramml.ml @@ -64,6 +64,15 @@ let make_rule f prod = let act = ty_eval ty_rule f in Extend.Rule (symb, act) +let rec proj_symbol : type a b c. (a, b, c) ty_user_symbol -> (a, b, c) genarg_type = function +| TUentry a -> ExtraArg a +| TUentryl (a,l) -> ExtraArg a +| TUopt(o) -> OptArg (proj_symbol o) +| TUlist1 l -> ListArg (proj_symbol l) +| TUlist1sep (l,_) -> ListArg (proj_symbol l) +| TUlist0 l -> ListArg (proj_symbol l) +| TUlist0sep (l,_) -> ListArg (proj_symbol l) + (** Vernac grammar extensions *) let vernac_exts = ref [] diff --git a/vernac/egramml.mli b/vernac/egramml.mli index a5ee036db5..c4f4fcfaa4 100644 --- a/vernac/egramml.mli +++ b/vernac/egramml.mli @@ -26,6 +26,8 @@ val extend_vernac_command_grammar : val get_extend_vernac_rule : Vernacexpr.extend_name -> vernac_expr grammar_prod_item list +val proj_symbol : ('a, 'b, 'c) Extend.ty_user_symbol -> ('a, 'b, 'c) Genarg.genarg_type + (** Utility function reused in Egramcoq : *) val make_rule : diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg index a35a1998d3..74516e320c 100644 --- a/vernac/g_vernac.mlg +++ b/vernac/g_vernac.mlg @@ -59,7 +59,7 @@ let make_bullet s = | '*' -> Star n | _ -> assert false -let parse_compat_version ?(allow_old = true) = let open Flags in function +let parse_compat_version = let open Flags in function | "8.8" -> Current | "8.7" -> V8_7 | "8.6" -> V8_6 @@ -1087,6 +1087,11 @@ GRAMMAR EXTEND Gram r = red_expr -> { VernacDeclareReduction (s,r) } +(* factorized here, though relevant for syntax extensions *) + + | IDENT "Declare"; IDENT "Custom"; IDENT "Entry"; s = IDENT -> + { VernacDeclareCustomEntry s } + ] ]; END @@ -1153,6 +1158,9 @@ GRAMMAR EXTEND Gram ; syntax_modifier: [ [ "at"; IDENT "level"; n = natural -> { SetLevel n } + | "in"; IDENT "custom"; x = IDENT -> { SetCustomEntry (x,None) } + | "in"; IDENT "custom"; x = IDENT; "at"; IDENT "level"; n = natural -> + { SetCustomEntry (x,Some n) } | IDENT "left"; IDENT "associativity" -> { SetAssoc LeftA } | IDENT "right"; IDENT "associativity" -> { SetAssoc RightA } | IDENT "no"; IDENT "associativity" -> { SetAssoc NonA } @@ -1166,23 +1174,27 @@ GRAMMAR EXTEND Gram | { CAst.v = k }, Some s -> SetFormat(k,s) | s, None -> SetFormat ("text",s) end } | x = IDENT; ","; l = LIST1 [id = IDENT -> { id } ] SEP ","; "at"; - lev = level -> { SetItemLevel (x::l,lev) } - | x = IDENT; "at"; lev = level -> { SetItemLevel ([x],lev) } - | x = IDENT; "at"; lev = level; b = constr_as_binder_kind -> { SetItemLevelAsBinder ([x],b,Some lev) } - | x = IDENT; b = constr_as_binder_kind -> { SetItemLevelAsBinder ([x],b,None) } + lev = level -> { SetItemLevel (x::l,None,Some lev) } + | x = IDENT; "at"; lev = level -> { SetItemLevel ([x],None,Some lev) } + | x = IDENT; "at"; lev = level; b = constr_as_binder_kind -> + { SetItemLevel ([x],Some b,Some lev) } + | x = IDENT; b = constr_as_binder_kind -> { SetItemLevel ([x],Some b,None) } | x = IDENT; typ = syntax_extension_type -> { SetEntryType (x,typ) } ] ] ; syntax_extension_type: - [ [ IDENT "ident" -> { ETName } | IDENT "global" -> { ETReference } + [ [ IDENT "ident" -> { ETIdent } | IDENT "global" -> { ETGlobal } | IDENT "bigint" -> { ETBigint } | IDENT "binder" -> { ETBinder true } - | IDENT "constr"; n = OPT at_level; b = constr_as_binder_kind -> { ETConstrAsBinder (b,n) } + | IDENT "constr" -> { ETConstr (InConstrEntry,None,None) } + | IDENT "constr"; n = OPT at_level; b = OPT constr_as_binder_kind -> { ETConstr (InConstrEntry,b,n) } | IDENT "pattern" -> { ETPattern (false,None) } | IDENT "pattern"; "at"; IDENT "level"; n = natural -> { ETPattern (false,Some n) } | IDENT "strict"; IDENT "pattern" -> { ETPattern (true,None) } | IDENT "strict"; IDENT "pattern"; "at"; IDENT "level"; n = natural -> { ETPattern (true,Some n) } | IDENT "closed"; IDENT "binder" -> { ETBinder false } + | IDENT "custom"; x = IDENT; n = OPT at_level; b = OPT constr_as_binder_kind -> + { ETConstr (InCustomEntry x,b,n) } ] ] ; at_level: diff --git a/vernac/himsg.ml b/vernac/himsg.ml index c49ffe2679..b9c47ff475 100644 --- a/vernac/himsg.ml +++ b/vernac/himsg.ml @@ -194,12 +194,6 @@ let rec pr_disjunction pr = function | a::l -> pr a ++ str "," ++ spc () ++ pr_disjunction pr l | [] -> assert false -let pr_puniverses f env (c,u) = - f env c ++ - (if Flags.is_universe_polymorphism () && not (Univ.Instance.is_empty u) then - str"(*" ++ Univ.Instance.pr UnivNames.pr_with_global_universes u ++ str"*)" - else mt()) - let explain_elim_arity env sigma ind sorts c pj okinds = let open EConstr in let env = make_all_name_different env sigma in @@ -262,7 +256,7 @@ let explain_ill_formed_branch env sigma c ci actty expty = let pa, pe = pr_explicit env sigma (simp actty) (simp expty) in strbrk "In pattern-matching on term" ++ brk(1,1) ++ pc ++ spc () ++ strbrk "the branch for constructor" ++ spc () ++ - quote (pr_puniverses pr_constructor env ci) ++ + quote (pr_pconstructor env sigma ci) ++ spc () ++ str "has type" ++ brk(1,1) ++ pa ++ spc () ++ str "which should be" ++ brk(1,1) ++ pe ++ str "." @@ -1233,12 +1227,7 @@ let explain_wrong_numarg_inductive env ind n = str " expects " ++ decline_string n "argument" ++ str "." let explain_unused_clause env pats = -(* Without localisation - let s = if List.length pats > 1 then "s" else "" in - (str ("Unused clause with pattern"^s) ++ spc () ++ - hov 0 (pr_sequence pr_cases_pattern pats) ++ str ")") -*) - str "This clause is redundant." + str "Pattern \"" ++ hov 0 (prlist_with_sep pr_comma pr_cases_pattern pats) ++ strbrk "\" is redundant in this clause." let explain_non_exhaustive env pats = str "Non exhaustive pattern-matching: no clause found for " ++ diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml index 33e6229b29..d66a121437 100644 --- a/vernac/metasyntax.ml +++ b/vernac/metasyntax.ml @@ -283,20 +283,30 @@ let error_not_same_scope x y = (**********************************************************************) (* Build pretty-printing rules *) +let pr_notation_entry = function + | InConstrEntry -> str "constr" + | InCustomEntry s -> str "custom " ++ str s + let prec_assoc = function | RightA -> (L,E) | LeftA -> (E,L) | NonA -> (L,L) -let precedence_of_position_and_level from = function +let precedence_of_position_and_level from_level = function | NumLevel n, BorderProd (_,None) -> n, Prec n | NumLevel n, BorderProd (b,Some a) -> n, let (lp,rp) = prec_assoc a in if b == Left then lp else rp | NumLevel n, InternalProd -> n, Prec n - | NextLevel, _ -> from, L - -let precedence_of_entry_type from = function - | ETConstr x | ETConstrAsBinder (_,x) -> precedence_of_position_and_level from x + | NextLevel, _ -> from_level, L + +let precedence_of_entry_type (from_custom,from_level) = function + | ETConstr (custom,_,x) when notation_entry_eq custom from_custom -> + precedence_of_position_and_level from_level x + | ETConstr (custom,_,(NumLevel n,_)) -> n, Prec n + | ETConstr (custom,_,(NextLevel,_)) -> + user_err (strbrk "\"next level\" is only for sub-expressions in the same entry as where the notation is (" ++ + quote (pr_notation_entry custom) ++ strbrk " is different from " ++ + quote (pr_notation_entry from_custom) ++ str ").") | ETPattern (_,n) -> let n = match n with None -> 0 | Some n -> n in n, Prec n | _ -> 0, E (* should not matter *) @@ -367,15 +377,14 @@ let unparsing_metavar i from typs = let x = List.nth typs (i-1) in let prec = snd (precedence_of_entry_type from x) in match x with - | ETConstr _ | ETConstrAsBinder _ | ETReference | ETBigint -> + | ETConstr _ | ETGlobal | ETBigint -> UnpMetaVar (i,prec) | ETPattern _ -> UnpBinderMetaVar (i,prec) - | ETName -> - UnpBinderMetaVar (i,Prec 0) + | ETIdent -> + UnpBinderMetaVar (i,prec) | ETBinder isopen -> assert false - | ETOther _ -> failwith "TODO" (* Heuristics for building default printing rules *) @@ -561,11 +570,10 @@ let hunks_of_format (from,(vars,typs)) symfmt = (**********************************************************************) (* Build parsing rules *) -let assoc_of_type n (_,typ) = precedence_of_entry_type n typ +let assoc_of_type from n (_,typ) = precedence_of_entry_type (from,n) typ let is_not_small_constr = function ETProdConstr _ -> true - | ETProdOther("constr","binder_constr") -> true | _ -> false let rec define_keywords_aux = function @@ -595,9 +603,9 @@ let distribute a ll = List.map (fun l -> a @ l) ll t;sep;t;...;t;sep;t;...;t;sep;t (p+n times) t;sep;t;...;t;sep;t;...;t;sep;t;LIST1(t,sep) *) -let expand_list_rule typ tkl x n p ll = +let expand_list_rule s typ tkl x n p ll = let camlp5_message_name = Some (add_suffix x ("_"^string_of_int n)) in - let main = GramConstrNonTerminal (ETProdConstr typ, camlp5_message_name) in + let main = GramConstrNonTerminal (ETProdConstr (s,typ), camlp5_message_name) in let tks = List.map (fun x -> GramConstrTerminal x) tkl in let rec aux i hds ll = if i < p then aux (i+1) (main :: tks @ hds) ll @@ -613,7 +621,7 @@ let expand_list_rule typ tkl x n p ll = let is_constr_typ typ x etyps = match List.assoc x etyps with - | ETConstr typ' | ETConstrAsBinder (_,typ') -> typ = typ' + | ETConstr (_,_,typ') -> typ = typ' | _ -> false let include_possible_similar_trailing_pattern typ etyps sl l = @@ -627,13 +635,12 @@ let include_possible_similar_trailing_pattern typ etyps sl l = try_aux 0 l let prod_entry_type = function - | ETName -> ETProdName - | ETReference -> ETProdReference + | ETIdent -> ETProdName + | ETGlobal -> ETProdReference | ETBigint -> ETProdBigint | ETBinder _ -> assert false (* See check_binder_type *) - | ETConstr p | ETConstrAsBinder (_,p) -> ETProdConstr p + | ETConstr (s,_,p) -> ETProdConstr (s,p) | ETPattern (_,n) -> ETProdPattern (match n with None -> 0 | Some n -> n) - | ETOther (s,t) -> ETProdOther (s,t) let make_production etyps symbols = let rec aux = function @@ -651,9 +658,9 @@ let make_production etyps symbols = | Break _ -> [] | _ -> anomaly (Pp.str "Found a non terminal token in recursive notation separator.")) sl) in match List.assoc x etyps with - | ETConstr typ -> + | ETConstr (s,_,typ) -> let p,l' = include_possible_similar_trailing_pattern typ etyps sl l in - expand_list_rule typ tkl x 1 p (aux l') + expand_list_rule s typ tkl x 1 p (aux l') | ETBinder o -> check_open_binder o sl x; let typ = if o then (assert (tkl = []); ETBinderOpen) else ETBinderClosed tkl in @@ -675,8 +682,7 @@ let rec find_symbols c_current c_next c_last = function (x,c_next)::(find_symbols c_next c_next c_last sl') let border = function - | (_,ETConstr(_,BorderProd (_,a))) :: _ -> a - | (_,(ETConstrAsBinder(_,(_,BorderProd (_,a))))) :: _ -> a + | (_,(ETConstr(_,_,(_,BorderProd (_,a))))) :: _ -> a | _ -> None let recompute_assoc typs = @@ -698,23 +704,24 @@ let pr_arg_level from (lev,typ) = | (n,_) -> str "Unknown level" in Ppvernac.pr_set_entry_type (fun _ -> (*TO CHECK*) mt()) typ ++ (match typ with - | ETConstr _ | ETConstrAsBinder _ | ETPattern _ -> spc () ++ pplev lev + | ETConstr _ | ETPattern _ -> spc () ++ pplev lev | _ -> mt ()) -let pr_level ntn (from,args,typs) = - str "at level " ++ int from ++ spc () ++ str "with arguments" ++ spc() ++ - prlist_with_sep pr_comma (pr_arg_level from) (List.combine args typs) +let pr_level ntn (from,fromlevel,args,typs) = + (match from with InConstrEntry -> mt () | InCustomEntry s -> str "in " ++ str s ++ spc()) ++ + str "at level " ++ int fromlevel ++ spc () ++ str "with arguments" ++ spc() ++ + prlist_with_sep pr_comma (pr_arg_level fromlevel) (List.combine args typs) let error_incompatible_level ntn oldprec prec = user_err - (str "Notation " ++ qstring ntn ++ str " is already defined" ++ spc() ++ + (str "Notation " ++ pr_notation ntn ++ str " is already defined" ++ spc() ++ pr_level ntn oldprec ++ spc() ++ str "while it is now required to be" ++ spc() ++ pr_level ntn prec ++ str ".") let error_parsing_incompatible_level ntn ntn' oldprec prec = user_err - (str "Notation " ++ qstring ntn ++ str " relies on a parsing rule for " ++ qstring ntn' ++ spc() ++ + (str "Notation " ++ pr_notation ntn ++ str " relies on a parsing rule for " ++ pr_notation ntn' ++ spc() ++ str " which is already defined" ++ spc() ++ pr_level ntn oldprec ++ spc() ++ str "while it is now required to be" ++ spc() ++ @@ -738,7 +745,7 @@ type syntax_extension_obj = locality_flag * syntax_extension let check_and_extend_constr_grammar ntn rule = try let ntn_for_grammar = rule.notgram_notation in - if String.equal ntn ntn_for_grammar then raise Not_found; + if notation_eq ntn ntn_for_grammar then raise Not_found; let prec = rule.notgram_level in let oldprec = Notgram_ops.level_of_notation ntn_for_grammar in if not (Notgram_ops.level_eq prec oldprec) then error_parsing_incompatible_level ntn ntn_for_grammar oldprec prec; @@ -760,7 +767,7 @@ let cache_one_syntax_extension se = if not onlyprint then List.iter (check_and_extend_constr_grammar ntn) se.synext_notgram.notgram_rules; (* Declare the notation rule *) declare_notation_rule ntn - ~extra:se.synext_extra (se.synext_unparsing, pi1 prec) se.synext_notgram + ~extra:se.synext_extra (se.synext_unparsing, let (_,lev,_,_) = prec in lev) se.synext_notgram end let cache_syntax_extension (_, (_, sy)) = @@ -797,7 +804,9 @@ module NotationMods = struct type notation_modifier = { assoc : gram_assoc option; level : int option; + custom : notation_entry; etyps : (Id.t * simple_constr_prod_entry_key) list; + subtyps : (Id.t * production_level) list; (* common to syn_data below *) only_parsing : bool; @@ -810,7 +819,9 @@ type notation_modifier = { let default = { assoc = None; level = None; + custom = InConstrEntry; etyps = []; + subtyps = []; only_parsing = false; only_printing = false; compat = None; @@ -821,53 +832,75 @@ let default = { end let interp_modifiers modl = let open NotationMods in - let rec interp acc = function - | [] -> acc + let rec interp subtyps acc = function + | [] -> subtyps, acc | SetEntryType (s,typ) :: l -> let id = Id.of_string s in if Id.List.mem_assoc id acc.etyps then user_err ~hdr:"Metasyntax.interp_modifiers" (str s ++ str " is already assigned to an entry or constr level."); - interp { acc with etyps = (id,typ) :: acc.etyps; } l - | SetItemLevel ([],n) :: l -> - interp acc l - | SetItemLevelAsBinder ([],_,_) :: l -> - interp acc l - | SetItemLevel (s::idl,n) :: l -> + interp subtyps { acc with etyps = (id,typ) :: acc.etyps; } l + | SetItemLevel ([],bko,n) :: l -> + interp subtyps acc l + | SetItemLevel (s::idl,bko,n) :: l -> let id = Id.of_string s in if Id.List.mem_assoc id acc.etyps then user_err ~hdr:"Metasyntax.interp_modifiers" (str s ++ str " is already assigned to an entry or constr level."); - let typ = ETConstr (Some n) in - interp { acc with etyps = (id,typ)::acc.etyps; } (SetItemLevel (idl,n)::l) - | SetItemLevelAsBinder (s::idl,bk,n) :: l -> - let id = Id.of_string s in - if Id.List.mem_assoc id acc.etyps then - user_err ~hdr:"Metasyntax.interp_modifiers" - (str s ++ str " is already assigned to an entry or constr level."); - let typ = ETConstrAsBinder (bk,n) in - interp { acc with etyps = (id,typ)::acc.etyps; } (SetItemLevelAsBinder (idl,bk,n)::l) + interp ((id,bko,n)::subtyps) acc (SetItemLevel (idl,bko,n)::l) | SetLevel n :: l -> - interp { acc with level = Some n; } l + (match acc.custom with + | InCustomEntry s -> + if acc.level <> None then + user_err (str ("isolated \"at level " ^ string_of_int n ^ "\" unexpected.")) + else + user_err (str ("use \"in custom " ^ s ^ " at level " ^ string_of_int n ^ + "\"") ++ spc () ++ str "rather than" ++ spc () ++ + str ("\"at level " ^ string_of_int n ^ "\"") ++ + spc () ++ str "isolated.") + | InConstrEntry -> + if acc.level <> None then + user_err (str "A level is already assigned."); + interp subtyps { acc with level = Some n; } l) + | SetCustomEntry (s,n) :: l -> + if acc.level <> None then + (if n = None then + user_err (str ("use \"in custom " ^ s ^ " at level " ^ + string_of_int (Option.get acc.level) ^ + "\"") ++ spc () ++ str "rather than" ++ spc () ++ + str ("\"at level " ^ + string_of_int (Option.get acc.level) ^ "\"") ++ + spc () ++ str "isolated.") + else + user_err (str ("isolated \"at level " ^ string_of_int (Option.get acc.level) ^ "\" unexpected."))); + if acc.custom <> InConstrEntry then + user_err (str "Entry is already assigned to custom " ++ str s ++ (match acc.level with None -> mt () | Some lev -> str " at level " ++ int lev) ++ str "."); + interp subtyps { acc with custom = InCustomEntry s; level = n } l | SetAssoc a :: l -> if not (Option.is_empty acc.assoc) then user_err Pp.(str "An associativity is given more than once."); - interp { acc with assoc = Some a; } l + interp subtyps { acc with assoc = Some a; } l | SetOnlyParsing :: l -> - interp { acc with only_parsing = true; } l + interp subtyps { acc with only_parsing = true; } l | SetOnlyPrinting :: l -> - interp { acc with only_printing = true; } l + interp subtyps { acc with only_printing = true; } l | SetCompatVersion v :: l -> - interp { acc with compat = Some v; } l + interp subtyps { acc with compat = Some v; } l | SetFormat ("text",s) :: l -> if not (Option.is_empty acc.format) then user_err Pp.(str "A format is given more than once."); - interp { acc with format = Some s; } l - | SetFormat (k,{CAst.v=s}) :: l -> - interp { acc with extra = (k,s)::acc.extra; } l - in interp default modl + interp subtyps { acc with format = Some s; } l + | SetFormat (k,s) :: l -> + interp subtyps { acc with extra = (k,s.CAst.v)::acc.extra; } l + in + let subtyps,mods = interp [] default modl in + (* interpret item levels wrt to main entry *) + let extra_etyps = List.map (fun (id,bko,n) -> (id,ETConstr (mods.custom,bko,n))) subtyps in + { mods with etyps = extra_etyps@mods.etyps } let check_infix_modifiers modifiers = - let t = (interp_modifiers modifiers).NotationMods.etyps in - if not (List.is_empty t) then + let mods = interp_modifiers modifiers in + let t = mods.NotationMods.etyps in + let u = mods.NotationMods.subtyps in + if not (List.is_empty t) || not (List.is_empty u) then user_err Pp.(str "Explicit entry level or type unexpected in infix notation.") let check_useless_entry_types recvars mainvars etyps = @@ -908,21 +941,18 @@ let get_compat_version mods = (* Compute precedences from modifiers (or find default ones) *) -let set_entry_type etyps (x,typ) = +let set_entry_type from etyps (x,typ) = let typ = try match List.assoc x etyps, typ with - | ETConstr (Some n), (_,BorderProd (left,_)) -> - ETConstr (n,BorderProd (left,None)) - | ETConstr (Some n), (_,InternalProd) -> ETConstr (n,InternalProd) - | ETConstrAsBinder (bk, Some n), (_,BorderProd (left,_)) -> - ETConstrAsBinder (bk, (n,BorderProd (left,None))) - | ETConstrAsBinder (bk, Some n), (_,InternalProd) -> - ETConstrAsBinder (bk, (n,InternalProd)) + | ETConstr (s,bko,Some n), (_,BorderProd (left,_)) -> + ETConstr (s,bko,(n,BorderProd (left,None))) + | ETConstr (s,bko,Some n), (_,InternalProd) -> + ETConstr (s,bko,(n,InternalProd)) | ETPattern (b,n), _ -> ETPattern (b,n) - | (ETName | ETBigint | ETReference | ETBinder _ | ETOther _ as x), _ -> x - | ETConstr None, _ -> ETConstr typ - | ETConstrAsBinder (bk,None), _ -> ETConstrAsBinder (bk,typ) - with Not_found -> ETConstr typ + | (ETIdent | ETBigint | ETGlobal | ETBinder _ as x), _ -> x + | ETConstr (s,bko,None), _ -> ETConstr (s,bko,typ) + with Not_found -> + ETConstr (from,None,typ) in (x,typ) let join_auxiliary_recursive_types recvars etyps = @@ -942,8 +972,8 @@ let join_auxiliary_recursive_types recvars etyps = let internalization_type_of_entry_type = function | ETBinder _ -> NtnInternTypeOnlyBinder - | ETConstr _ | ETConstrAsBinder _ | ETBigint | ETReference - | ETName | ETPattern _ | ETOther _ -> NtnInternTypeAny + | ETConstr _ | ETBigint | ETGlobal + | ETIdent | ETPattern _ -> NtnInternTypeAny let set_internalization_type typs = List.map (fun (_, e) -> internalization_type_of_entry_type e) typs @@ -954,20 +984,28 @@ let make_internalization_vars recvars mainvars typs = maintyps @ extratyps let make_interpretation_type isrec isonlybinding = function - | ETConstr _ -> - if isrec then NtnTypeConstrList else - if isonlybinding then - (* Parsed as constr, but interpreted as a binder: default is to parse it as an ident only *) - NtnTypeBinder (NtnBinderParsedAsConstr AsIdent) - else NtnTypeConstr - | ETConstrAsBinder (bk,_) -> NtnTypeBinder (NtnBinderParsedAsConstr bk) - | ETName -> NtnTypeBinder NtnParsedAsIdent + (* Parsed as constr list *) + | ETConstr (_,None,_) when isrec -> NtnTypeConstrList + (* Parsed as constr, but interpreted as a binder: default is to parse it as an ident only *) + | ETConstr (_,Some bk,_) -> NtnTypeBinder (NtnBinderParsedAsConstr bk) + | ETConstr (_,None,_) when isonlybinding -> NtnTypeBinder (NtnBinderParsedAsConstr AsIdent) + (* Parsed as constr, interpreted as constr *) + | ETConstr (_,None,_) -> NtnTypeConstr + (* Others *) + | ETIdent -> NtnTypeBinder NtnParsedAsIdent | ETPattern (ppstrict,_) -> NtnTypeBinder (NtnParsedAsPattern ppstrict) (* Parsed as ident/pattern, primarily interpreted as binder; maybe strict at printing *) - | ETBigint | ETReference | ETOther _ -> NtnTypeConstr + | ETBigint | ETGlobal -> NtnTypeConstr | ETBinder _ -> if isrec then NtnTypeBinderList else anomaly Pp.(str "Type binder is only for use in recursive notations for binders.") +let subentry_of_constr_prod_entry = function + | ETConstr (InCustomEntry s,_,(NumLevel n,_)) -> InCustomEntryLevel (s,n) + (* level and use of parentheses for coercion is hard-wired for "constr"; + we don't remember the level *) + | ETConstr (InConstrEntry,_,_) -> InConstrEntrySomeLevel + | _ -> InConstrEntrySomeLevel + let make_interpretation_vars recvars allvars typs = let eq_subscope (sc1, l1) (sc2, l2) = Option.equal String.equal sc1 sc2 && @@ -983,7 +1021,9 @@ let make_interpretation_vars recvars allvars typs = let mainvars = Id.Map.filter (fun x _ -> not (Id.List.mem x useless_recvars)) allvars in Id.Map.mapi (fun x (isonlybinding, sc) -> - (sc, make_interpretation_type (Id.List.mem_assoc x recvars) isonlybinding (Id.List.assoc x typs))) mainvars + let typ = Id.List.assoc x typs in + ((subentry_of_constr_prod_entry typ,sc), + make_interpretation_type (Id.List.mem_assoc x recvars) isonlybinding typ)) mainvars let check_rule_productivity l = if List.for_all (function NonTerminal _ | Break _ -> true | _ -> false) l then @@ -1009,17 +1049,42 @@ let warn_non_reversible_notation = str " not occur in the right-hand side." ++ spc() ++ strbrk "The notation will not be used for printing as it is not reversible.") -let is_not_printable onlyparse reversibility = function -| NVar _ -> - if not onlyparse then warn_notation_bound_to_variable (); - true +let make_custom_entry custom level = + match custom with + | InConstrEntry -> InConstrEntrySomeLevel + | InCustomEntry s -> InCustomEntryLevel (s,level) + +type entry_coercion_kind = + | IsEntryCoercion of notation_entry_level + | IsEntryGlobal of string * int + | IsEntryIdent of string * int + +let is_coercion = function + | Some (custom,n,_,[e]) -> + (match e, custom with + | ETConstr _, _ -> + let customkey = make_custom_entry custom n in + let subentry = subentry_of_constr_prod_entry e in + if notation_entry_level_eq subentry customkey then None + else Some (IsEntryCoercion subentry) + | ETGlobal, InCustomEntry s -> Some (IsEntryGlobal (s,n)) + | ETIdent, InCustomEntry s -> Some (IsEntryIdent (s,n)) + | _ -> None) + | Some _ -> assert false + | None -> None + +let printability level onlyparse reversibility = function +| NVar _ when reversibility = APrioriReversible -> + let coe = is_coercion level in + if not onlyparse && coe = None then + warn_notation_bound_to_variable (); + true, coe | _ -> - if not onlyparse && reversibility <> APrioriReversible then + (if not onlyparse && reversibility <> APrioriReversible then (warn_non_reversible_notation reversibility; true) - else onlyparse + else onlyparse),None - -let find_precedence lev etyps symbols onlyprint = +let find_precedence custom lev etyps symbols onlyprint = let first_symbol = let rec aux = function | Break _ :: t -> aux t @@ -1043,10 +1108,9 @@ let find_precedence lev etyps symbols onlyprint = else [],Option.get lev else user_err Pp.(str "The level of the leftmost non-terminal cannot be changed.") in - (try match List.assoc x etyps with - | ETConstr _ -> test () - | ETConstrAsBinder (_,Some _) -> test () - | (ETName | ETBigint | ETReference) -> + (try match List.assoc x etyps, custom with + | ETConstr (s,_,Some _), s' when s = s' -> test () + | (ETIdent | ETBigint | ETGlobal), _ -> begin match lev with | None -> ([Feedback.msg_info ?loc:None ,strbrk "Setting notation at level 0."],0) @@ -1055,7 +1119,7 @@ let find_precedence lev etyps symbols onlyprint = | _ -> user_err Pp.(str "A notation starting with an atomic expression must be at level 0.") end - | (ETPattern _ | ETBinder _ | ETOther _ | ETConstrAsBinder _) -> + | (ETPattern _ | ETBinder _ | ETConstr _), _ -> (* Give a default ? *) if Option.is_empty lev then user_err Pp.(str "Need an explicit level.") @@ -1073,7 +1137,7 @@ let find_precedence lev etyps symbols onlyprint = [],Option.get lev let check_curly_brackets_notation_exists () = - try let _ = Notgram_ops.level_of_notation "{ _ }" in () + try let _ = Notgram_ops.level_of_notation (InConstrEntrySomeLevel,"{ _ }") in () with Not_found -> user_err Pp.(str "Notations involving patterns of the form \"{ _ }\" are treated \n\ specially and require that the notation \"{ _ }\" is already reserved.") @@ -1103,7 +1167,7 @@ let remove_curly_brackets l = module SynData = struct - type subentry_types = (Id.t * (production_level * production_position) constr_entry_key_gen) list + type subentry_types = (Id.t * constr_entry_key) list (* XXX: Document *) type syn_data = { @@ -1137,7 +1201,7 @@ module SynData = struct end -let find_subentry_types n assoc etyps symbols = +let find_subentry_types from n assoc etyps symbols = let innerlevel = NumLevel 200 in let typs = find_symbols @@ -1145,11 +1209,21 @@ let find_subentry_types n assoc etyps symbols = (innerlevel,InternalProd) (NumLevel n,BorderProd(Right,assoc)) symbols in - let sy_typs = List.map (set_entry_type etyps) typs in - let prec = List.map (assoc_of_type n) sy_typs in + let sy_typs = List.map (set_entry_type from etyps) typs in + let prec = List.map (assoc_of_type from n) sy_typs in sy_typs, prec -let compute_syntax_data df modifiers = +let check_locality_compatibility local custom i_typs = + if not local then + let subcustom = List.map_filter (function _,ETConstr (InCustomEntry s,_,_) -> Some s | _ -> None) i_typs in + let allcustoms = match custom with InCustomEntry s -> s::subcustom | _ -> subcustom in + List.iter (fun s -> + if Egramcoq.locality_of_custom_entry s then + user_err (strbrk "Notation has to be declared local as it depends on custom entry " ++ str s ++ + strbrk " which is local.")) + (List.uniquize allcustoms) + +let compute_syntax_data local df modifiers = let open SynData in let open NotationMods in let mods = interp_modifiers modifiers in @@ -1162,25 +1236,28 @@ let compute_syntax_data df modifiers = let _ = check_binder_type recvars mods.etyps in (* Notations for interp and grammar *) - let ntn_for_interp = make_notation_key symbols in - let symbols_for_grammar = remove_curly_brackets symbols in + let msgs,n = find_precedence mods.custom mods.level mods.etyps symbols onlyprint in + let custom = make_custom_entry mods.custom n in + let ntn_for_interp = make_notation_key custom symbols in + let symbols_for_grammar = + if custom = InConstrEntrySomeLevel then remove_curly_brackets symbols else symbols in let need_squash = not (List.equal Notation.symbol_eq symbols symbols_for_grammar) in - let ntn_for_grammar = if need_squash then make_notation_key symbols_for_grammar else ntn_for_interp in - if not onlyprint then check_rule_productivity symbols_for_grammar; - let msgs,n = find_precedence mods.level mods.etyps symbols onlyprint in + let ntn_for_grammar = if need_squash then make_notation_key custom symbols_for_grammar else ntn_for_interp in + if mods.custom = InConstrEntry && not onlyprint then check_rule_productivity symbols_for_grammar; (* To globalize... *) let etyps = join_auxiliary_recursive_types recvars mods.etyps in let sy_typs, prec = - find_subentry_types n assoc etyps symbols in + find_subentry_types mods.custom n assoc etyps symbols in let sy_typs_for_grammar, prec_for_grammar = if need_squash then - find_subentry_types n assoc etyps symbols_for_grammar + find_subentry_types mods.custom n assoc etyps symbols_for_grammar else sy_typs, prec in let i_typs = set_internalization_type sy_typs in + check_locality_compatibility local mods.custom sy_typs; let pa_sy_data = (sy_typs_for_grammar,symbols_for_grammar) in let pp_sy_data = (sy_typs,symbols) in - let sy_fulldata = (ntn_for_grammar,(n,prec_for_grammar,List.map snd sy_typs_for_grammar),need_squash) in + let sy_fulldata = (ntn_for_grammar,(mods.custom,n,prec_for_grammar,List.map snd sy_typs_for_grammar),need_squash) in let df' = ((Lib.library_dp(),Lib.current_dirpath true),df) in let i_data = ntn_for_interp, df' in @@ -1199,15 +1276,15 @@ let compute_syntax_data df modifiers = mainvars; intern_typs = i_typs; - level = (n,prec,List.map snd sy_typs); + level = (mods.custom,n,prec,List.map snd sy_typs); pa_syntax_data = pa_sy_data; pp_syntax_data = pp_sy_data; not_data = sy_fulldata; } -let compute_pure_syntax_data df mods = +let compute_pure_syntax_data local df mods = let open SynData in - let sd = compute_syntax_data df mods in + let sd = compute_syntax_data local df mods in let msgs = if sd.only_parsing then (Feedback.msg_warning ?loc:None, @@ -1222,6 +1299,7 @@ type notation_obj = { notobj_local : bool; notobj_scope : scope_name option; notobj_interp : interpretation; + notobj_coercion : entry_coercion_kind option; notobj_onlyparse : bool; notobj_onlyprint : bool; notobj_compat : Flags.compat_version option; @@ -1243,7 +1321,13 @@ let open_notation i (_, nobj) = let () = Notation.declare_notation_interpretation ntn scope pat df ~onlyprint in (* Declare the uninterpretation *) if not nobj.notobj_onlyparse then - Notation.declare_uninterpretation (NotationRule (scope, ntn)) pat + Notation.declare_uninterpretation (NotationRule (scope, ntn)) pat; + (* Declare a possible coercion *) + (match nobj.notobj_coercion with + | Some (IsEntryCoercion entry) -> Notation.declare_entry_coercion ntn entry + | Some (IsEntryGlobal (entry,n)) -> Notation.declare_custom_entry_has_global entry n + | Some (IsEntryIdent (entry,n)) -> Notation.declare_custom_entry_has_ident entry n + | None -> ()) end let cache_notation o = @@ -1301,7 +1385,7 @@ let recover_notation_syntax ntn = raise NoSyntaxRule let recover_squash_syntax sy = - let sq = recover_notation_syntax "{ _ }" in + let sq = recover_notation_syntax (InConstrEntrySomeLevel,"{ _ }") in sy :: sq.synext_notgram.notgram_rules (**********************************************************************) @@ -1336,8 +1420,9 @@ let make_pp_rule level (typs,symbols) fmt = (* let make_syntax_rules i_typs (ntn,prec,need_squash) sy_data fmt extra onlyprint compat = *) let make_syntax_rules (sd : SynData.syn_data) = let open SynData in let ntn_for_grammar, prec_for_grammar, need_squash = sd.not_data in + let custom,level,_,_ = sd.level in let pa_rule = make_pa_rule prec_for_grammar sd.pa_syntax_data ntn_for_grammar need_squash in - let pp_rule = make_pp_rule (pi1 sd.level) sd.pp_syntax_data sd.format in { + let pp_rule = make_pp_rule (custom,level) sd.pp_syntax_data sd.format in { synext_level = sd.level; synext_notation = fst sd.info; synext_notgram = { notgram_onlyprinting = sd.only_printing; notgram_rules = pa_rule }; @@ -1355,7 +1440,7 @@ let to_map l = let add_notation_in_scope local df env c mods scope = let open SynData in - let sd = compute_syntax_data df mods in + let sd = compute_syntax_data local df mods in (* Prepare the interpretation *) (* Prepare the parsing and printing rules *) let sy_rules = make_syntax_rules sd in @@ -1367,13 +1452,14 @@ let add_notation_in_scope local df env c mods scope = let (acvars, ac, reversibility) = interp_notation_constr env nenv c in let interp = make_interpretation_vars sd.recvars acvars (fst sd.pa_syntax_data) in let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in - let onlyparse = is_not_printable sd.only_parsing reversibility ac in + let onlyparse,coe = printability (Some sd.level) sd.only_parsing reversibility ac in let notation = { notobj_local = local; notobj_scope = scope; notobj_interp = (List.map_filter map i_vars, ac); (** Order is important here! *) notobj_onlyparse = onlyparse; + notobj_coercion = coe; notobj_onlyprint = sd.only_printing; notobj_compat = sd.compat; notobj_notation = sd.info; @@ -1387,16 +1473,17 @@ let add_notation_in_scope local df env c mods scope = let add_notation_interpretation_core local df env ?(impls=empty_internalization_env) c scope onlyparse onlyprint compat = let (recvars,mainvars,symbs) = analyze_notation_tokens ~onlyprint df in (* Recover types of variables and pa/pp rules; redeclare them if needed *) - let i_typs, onlyprint = if not (is_numeral symbs) then begin - let sy = recover_notation_syntax (make_notation_key symbs) in + let level, i_typs, onlyprint = if not (is_numeral symbs) then begin + let sy = recover_notation_syntax (make_notation_key InConstrEntrySomeLevel symbs) in let () = Lib.add_anonymous_leaf (inSyntaxExtension (local,sy)) in (** If the only printing flag has been explicitly requested, put it back *) let onlyprint = onlyprint || sy.synext_notgram.notgram_onlyprinting in - pi3 sy.synext_level, onlyprint - end else [], false in + let _,_,_,typs = sy.synext_level in + Some sy.synext_level, typs, onlyprint + end else None, [], false in (* Declare interpretation *) let path = (Lib.library_dp(), Lib.current_dirpath true) in - let df' = (make_notation_key symbs, (path,df)) in + let df' = (make_notation_key InConstrEntrySomeLevel symbs, (path,df)) in let i_vars = make_internalization_vars recvars mainvars (List.map internalization_type_of_entry_type i_typs) in let nenv = { ninterp_var_type = to_map i_vars; @@ -1405,13 +1492,14 @@ let add_notation_interpretation_core local df env ?(impls=empty_internalization_ let (acvars, ac, reversibility) = interp_notation_constr env ~impls nenv c in let interp = make_interpretation_vars recvars acvars (List.combine mainvars i_typs) in let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in - let onlyparse = is_not_printable onlyparse reversibility ac in + let onlyparse,coe = printability level onlyparse reversibility ac in let notation = { notobj_local = local; notobj_scope = scope; notobj_interp = (List.map_filter map i_vars, ac); (** Order is important here! *) notobj_onlyparse = onlyparse; + notobj_coercion = coe; notobj_onlyprint = onlyprint; notobj_compat = compat; notobj_notation = df'; @@ -1422,7 +1510,7 @@ let add_notation_interpretation_core local df env ?(impls=empty_internalization_ (* Notations without interpretation (Reserved Notation) *) let add_syntax_extension local ({CAst.loc;v=df},mods) = let open SynData in - let psd = compute_pure_syntax_data df mods in + let psd = compute_pure_syntax_data local df mods in let sy_rules = make_syntax_rules {psd with compat = None} in Flags.if_verbose (List.iter (fun (f,x) -> f x)) psd.msgs; Lib.add_anonymous_leaf (inSyntaxExtension(local,sy_rules)) @@ -1462,7 +1550,7 @@ let add_notation local env c ({CAst.loc;v=df},modifiers) sc = let add_notation_extra_printing_rule df k v = let notk = let _,_, symbs = analyze_notation_tokens ~onlyprint:true df in - make_notation_key symbs in + make_notation_key InConstrEntrySomeLevel symbs in add_notation_extra_printing_rule notk k v (* Infix notations *) @@ -1546,7 +1634,35 @@ let add_syntactic_definition env ident (vars,c) local onlyparse = List.map map vars, reversibility, pat in let onlyparse = match onlyparse with - | None when (is_not_printable false reversibility pat) -> Some Flags.Current + | None when fst (printability None false reversibility pat) -> Some Flags.Current | p -> p in Syntax_def.declare_syntactic_definition local ident onlyparse (vars,pat) + +(**********************************************************************) +(* Declaration of custom entry *) + +let load_custom_entry _ _ = () + +let open_custom_entry _ (_,(local,s)) = + Egramcoq.create_custom_entry ~local s + +let cache_custom_entry o = + load_custom_entry 1 o; + open_custom_entry 1 o + +let subst_custom_entry (subst,x) = x + +let classify_custom_entry (local,s as o) = + if local then Dispose else Substitute o + +let inCustomEntry : locality_flag * string -> obj = + declare_object {(default_object "CUSTOM-ENTRIES") with + cache_function = cache_custom_entry; + open_function = open_custom_entry; + load_function = load_custom_entry; + subst_function = subst_custom_entry; + classify_function = classify_custom_entry} + +let declare_custom_entry local s = + Lib.add_anonymous_leaf (inCustomEntry (local,s)) diff --git a/vernac/metasyntax.mli b/vernac/metasyntax.mli index f6de75b079..73bee7121b 100644 --- a/vernac/metasyntax.mli +++ b/vernac/metasyntax.mli @@ -60,3 +60,5 @@ val pr_grammar : string -> Pp.t val check_infix_modifiers : syntax_modifier list -> unit val with_syntax_protection : ('a -> 'b) -> 'a -> 'b + +val declare_custom_entry : locality_flag -> string -> unit diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml index e5547d9b75..93e4e89a12 100644 --- a/vernac/ppvernac.ml +++ b/vernac/ppvernac.ml @@ -97,25 +97,27 @@ open Pputils let sep = fun _ -> spc() let sep_v2 = fun _ -> str"," ++ spc() + let pr_notation_entry = function + | InConstrEntry -> keyword "constr" + | InCustomEntry s -> keyword "custom" ++ spc () ++ str s + let pr_at_level = function | NumLevel n -> keyword "at" ++ spc () ++ keyword "level" ++ spc () ++ int n | NextLevel -> keyword "at" ++ spc () ++ keyword "next" ++ spc () ++ keyword "level" let pr_constr_as_binder_kind = let open Notation_term in function - | AsIdent -> keyword "as ident" - | AsIdentOrPattern -> keyword "as pattern" - | AsStrictPattern -> keyword "as strict pattern" + | AsIdent -> spc () ++ keyword "as ident" + | AsIdentOrPattern -> spc () ++ keyword "as pattern" + | AsStrictPattern -> spc () ++ keyword "as strict pattern" let pr_strict b = if b then str "strict " else mt () let pr_set_entry_type pr = function - | ETName -> str"ident" - | ETReference -> str"global" + | ETIdent -> str"ident" + | ETGlobal -> str"global" | ETPattern (b,None) -> pr_strict b ++ str"pattern" | ETPattern (b,Some n) -> pr_strict b ++ str"pattern" ++ spc () ++ pr_at_level (NumLevel n) - | ETConstr lev -> str"constr" ++ pr lev - | ETOther (_,e) -> str e - | ETConstrAsBinder (bk,lev) -> pr lev ++ spc () ++ pr_constr_as_binder_kind bk + | ETConstr (s,bko,lev) -> pr_notation_entry s ++ pr lev ++ pr_opt pr_constr_as_binder_kind bko | ETBigint -> str "bigint" | ETBinder true -> str "binder" | ETBinder false -> str "closed binder" @@ -378,12 +380,11 @@ open Pputils let pr_thm_token k = keyword (Kindops.string_of_theorem_kind k) let pr_syntax_modifier = function - | SetItemLevel (l,n) -> - prlist_with_sep sep_v2 str l ++ spc () ++ pr_at_level n - | SetItemLevelAsBinder (l,bk,n) -> - prlist_with_sep sep_v2 str l ++ - spc() ++ pr_at_level_opt n ++ spc() ++ pr_constr_as_binder_kind bk + | SetItemLevel (l,bko,n) -> + prlist_with_sep sep_v2 str l ++ spc () ++ pr_at_level_opt n ++ + pr_opt pr_constr_as_binder_kind bko | SetLevel n -> pr_at_level (NumLevel n) + | SetCustomEntry (s,n) -> keyword "in" ++ spc() ++ keyword "custom" ++ spc() ++ str s ++ (match n with None -> mt () | Some n -> pr_at_level (NumLevel n)) | SetAssoc LeftA -> keyword "left associativity" | SetAssoc RightA -> keyword "right associativity" | SetAssoc NonA -> keyword "no associativity" @@ -674,6 +675,10 @@ open Pputils return ( keyword "Format Notation " ++ qs s ++ spc () ++ qs k ++ spc() ++ qs v ) + | VernacDeclareCustomEntry s -> + return ( + keyword "Declare Custom Entry " ++ str s + ) (* Gallina *) | VernacDefinition ((discharge,kind),id,b) -> (* A verifier... *) diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index b6bc76a2ed..5258ab2ea4 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -431,6 +431,10 @@ let vernac_notation ~atts = let local = enforce_module_locality atts.locality in Metasyntax.add_notation local (Global.env()) +let vernac_custom_entry ~atts s = + let local = enforce_module_locality atts.locality in + Metasyntax.declare_custom_entry local s + (***********) (* Gallina *) @@ -1983,8 +1987,9 @@ let vernac_subproof gln = match gln with | None -> Proof.focus subproof_cond () 1 p | Some (Goal_select.SelectNth n) -> Proof.focus subproof_cond () n p + | Some (Goal_select.SelectId id) -> Proof.focus_id subproof_cond () id p | _ -> user_err ~hdr:"bracket_selector" - (str "Brackets only support the single numbered goal selector.")) + (str "Brackets do not support multi-goal selectors.")) let vernac_end_subproof () = Proof_global.simple_with_current_proof (fun _ p -> @@ -2096,6 +2101,8 @@ let interp ?proof ~atts ~st c = vernac_notation ~atts c infpl sc | VernacNotationAddFormat(n,k,v) -> Metasyntax.add_notation_extra_printing_rule n k v + | VernacDeclareCustomEntry s -> + vernac_custom_entry ~atts s (* Gallina *) | VernacDefinition ((discharge,kind),lid,d) -> @@ -2224,6 +2231,7 @@ let check_vernac_supports_locality c l = | Some _, ( VernacOpenCloseScope _ | VernacSyntaxExtension _ | VernacInfix _ | VernacNotation _ + | VernacDeclareCustomEntry _ | VernacDefinition _ | VernacFixpoint _ | VernacCoFixpoint _ | VernacAssumption _ | VernacStartTheoremProof _ | VernacCoercion _ | VernacIdentityCoercion _ @@ -2436,3 +2444,121 @@ let interp ?verbosely ?proof ~st cmd = let exn = CErrors.push exn in Vernacstate.invalidate_cache (); iraise exn + +(** VERNAC EXTEND registering *) + +open Genarg +open Extend + +type classifier = Genarg.raw_generic_argument list -> vernac_classification + +type (_, _) ty_sig = +| TyNil : (atts:atts -> st:Vernacstate.t -> Vernacstate.t, Vernacexpr.vernac_classification) ty_sig +| TyTerminal : string * ('r, 's) ty_sig -> ('r, 's) ty_sig +| TyNonTerminal : + string option * ('a, 'b, 'c) Extend.ty_user_symbol * ('r, 's) ty_sig -> ('a -> 'r, 'a -> 's) ty_sig + +type ty_ml = TyML : bool * ('r, 's) ty_sig * 'r * 's option -> ty_ml + +let type_error () = CErrors.anomaly (Pp.str "Ill-typed VERNAC EXTEND") + +let rec untype_classifier : type r s. (r, s) ty_sig -> s -> classifier = function +| TyNil -> fun f args -> + begin match args with + | [] -> f + | _ :: _ -> type_error () + end +| TyTerminal (_, ty) -> fun f args -> untype_classifier ty f args +| TyNonTerminal (_, tu, ty) -> fun f args -> + begin match args with + | [] -> type_error () + | Genarg.GenArg (Rawwit tag, v) :: args -> + match Genarg.genarg_type_eq tag (Egramml.proj_symbol tu) with + | None -> type_error () + | Some Refl -> untype_classifier ty (f v) args + end + +(** Stupid GADTs forces us to duplicate the definition just for typing *) +let rec untype_command : type r s. (r, s) ty_sig -> r -> plugin_args vernac_command = function +| TyNil -> fun f args -> + begin match args with + | [] -> f + | _ :: _ -> type_error () + end +| TyTerminal (_, ty) -> fun f args -> untype_command ty f args +| TyNonTerminal (_, tu, ty) -> fun f args -> + begin match args with + | [] -> type_error () + | Genarg.GenArg (Rawwit tag, v) :: args -> + match Genarg.genarg_type_eq tag (Egramml.proj_symbol tu) with + | None -> type_error () + | Some Refl -> untype_command ty (f v) args + end + +let rec untype_user_symbol : type s a b c. (a, b, c) Extend.ty_user_symbol -> (s, a) Extend.symbol = function +| TUlist1 l -> Alist1 (untype_user_symbol l) +| TUlist1sep (l, s) -> Alist1sep (untype_user_symbol l, Atoken (CLexer.terminal s)) +| TUlist0 l -> Alist0 (untype_user_symbol l) +| TUlist0sep (l, s) -> Alist0sep (untype_user_symbol l, Atoken (CLexer.terminal s)) +| TUopt o -> Aopt (untype_user_symbol o) +| TUentry a -> Aentry (Pcoq.genarg_grammar (ExtraArg a)) +| TUentryl (a, i) -> Aentryl (Pcoq.genarg_grammar (ExtraArg a), string_of_int i) + +let rec untype_grammar : type r s. (r, s) ty_sig -> vernac_expr Egramml.grammar_prod_item list = function +| TyNil -> [] +| TyTerminal (tok, ty) -> Egramml.GramTerminal tok :: untype_grammar ty +| TyNonTerminal (id, tu, ty) -> + let t = Option.map (fun _ -> rawwit (Egramml.proj_symbol tu)) id in + let symb = untype_user_symbol tu in + Egramml.GramNonTerminal (Loc.tag (t, symb)) :: untype_grammar ty + +let _ = untype_classifier, untype_command, untype_grammar, untype_user_symbol + +let classifiers : classifier array String.Map.t ref = ref String.Map.empty + +let get_vernac_classifier (name, i) args = + (String.Map.find name !classifiers).(i) args + +let declare_vernac_classifier name f = + classifiers := String.Map.add name f !classifiers + +let vernac_extend ~command ?classifier ?entry ext = + let get_classifier (TyML (_, ty, _, cl)) = match cl with + | Some cl -> untype_classifier ty cl + | None -> + match classifier with + | Some cl -> fun _ -> cl command + | None -> + let e = match entry with + | None -> "COMMAND" + | Some e -> Pcoq.Gram.Entry.name e + in + let msg = Printf.sprintf "\ + Vernac entry \"%s\" misses a classifier. \ + A classifier is a function that returns an expression \ + of type vernac_classification (see Vernacexpr). You can: \n\ + - Use '... EXTEND %s CLASSIFIED AS QUERY ...' if the \ + new vernacular command does not alter the system state;\n\ + - Use '... EXTEND %s CLASSIFIED AS SIDEFF ...' if the \ + new vernacular command alters the system state but not the \ + parser nor it starts a proof or ends one;\n\ + - Use '... EXTEND %s CLASSIFIED BY f ...' to specify \ + a global function f. The function f will be called passing\ + \"%s\" as the only argument;\n\ + - Add a specific classifier in each clause using the syntax:\n\ + '[...] => [ f ] -> [...]'.\n\ + Specific classifiers have precedence over global \ + classifiers. Only one classifier is called." + command e e e command + in + CErrors.user_err (Pp.strbrk msg) + in + let cl = Array.map_of_list get_classifier ext in + let iter i (TyML (depr, ty, f, _)) = + let f = untype_command ty f in + let r = untype_grammar ty in + let () = vinterp_add depr (command, i) f in + Egramml.extend_vernac_command_grammar (command, i) entry r + in + let () = declare_vernac_classifier command cl in + List.iteri iter ext diff --git a/vernac/vernacentries.mli b/vernac/vernacentries.mli index 79f9c05ad8..fb2a30bac7 100644 --- a/vernac/vernacentries.mli +++ b/vernac/vernacentries.mli @@ -42,3 +42,33 @@ val universe_polymorphism_option_name : string list (** Elaborate a [atts] record out of a list of flags. Also returns whether polymorphism is explicitly (un)set. *) val attributes_of_flags : Vernacexpr.vernac_flags -> Vernacinterp.atts -> bool option * Vernacinterp.atts + +(** {5 VERNAC EXTEND} *) + +type classifier = Genarg.raw_generic_argument list -> Vernacexpr.vernac_classification + +type (_, _) ty_sig = +| TyNil : (atts:Vernacinterp.atts -> st:Vernacstate.t -> Vernacstate.t, Vernacexpr.vernac_classification) ty_sig +| TyTerminal : string * ('r, 's) ty_sig -> ('r, 's) ty_sig +| TyNonTerminal : + string option * + ('a, 'b, 'c) Extend.ty_user_symbol * ('r, 's) ty_sig -> + ('a -> 'r, 'a -> 's) ty_sig + +type ty_ml = TyML : bool (** deprecated *) * ('r, 's) ty_sig * 'r * 's option -> ty_ml + +(** Wrapper to dynamically extend vernacular commands. *) +val vernac_extend : + command:string -> + ?classifier:(string -> Vernacexpr.vernac_classification) -> + ?entry:Vernacexpr.vernac_expr Pcoq.Entry.t -> + ty_ml list -> unit + +(** {5 STM classifiers} *) + +val get_vernac_classifier : + Vernacexpr.extend_name -> classifier + +(** Low-level API, not for casual user. *) +val declare_vernac_classifier : + string -> classifier array -> unit diff --git a/vernac/vernacexpr.ml b/vernac/vernacexpr.ml index e97cac818a..8fb74e6d78 100644 --- a/vernac/vernacexpr.ml +++ b/vernac/vernacexpr.ml @@ -211,9 +211,9 @@ type proof_expr = ident_decl * (local_binder_expr list * constr_expr) type syntax_modifier = - | SetItemLevel of string list * Extend.production_level - | SetItemLevelAsBinder of string list * Notation_term.constr_as_binder_kind * Extend.production_level option + | SetItemLevel of string list * Notation_term.constr_as_binder_kind option * Extend.production_level option | SetLevel of int + | SetCustomEntry of string * int option | SetAssoc of Extend.gram_assoc | SetEntryType of string * Extend.simple_constr_prod_entry_key | SetOnlyParsing @@ -333,6 +333,7 @@ type nonrec vernac_expr = constr_expr * (lstring * syntax_modifier list) * scope_name option | VernacNotationAddFormat of string * string * string + | VernacDeclareCustomEntry of string (* Gallina *) | VernacDefinition of (Decl_kinds.discharge * Decl_kinds.definition_object_kind) * name_decl * definition_expr |