diff options
247 files changed, 4288 insertions, 2011 deletions
diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 5be434c8b7..65c971ce76 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -256,6 +256,15 @@ /theories/Vectors/ @herbelin +########## Dune ########## + +/Makefile.dune @ejgallego +/tools/coq_dune* @ejgallego +/dune* @ejgallego +/coq.opam @ejgallego +/ide/coqide.opam @ejgallego +# Secondary maintainer @Zimmi48 + ########## Tools ########## /tools/coqdoc/ @silene diff --git a/.gitignore b/.gitignore index 0e41d6a778..8fc3c802ad 100644 --- a/.gitignore +++ b/.gitignore @@ -183,3 +183,10 @@ plugins/ssr/ssrvernac.ml # ocaml dev files .merlin META.coq + +# Files automatically generated by Dune. +plugins/*/dune +theories/*/dune +theories/*/*/dune +theories/*/*/*/dune +*.install diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 492b658d98..7f770feded 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -9,7 +9,7 @@ stages: variables: # Format: $IMAGE-V$DATE [Cache is not used as of today but kept here # for reference] - CACHEKEY: "bionic_coq-V2018-07-11-V2" + CACHEKEY: "bionic_coq-V2018-08-27-V2" IMAGE: "$CI_REGISTRY_IMAGE:$CACHEKEY" # By default, jobs run in the base switch; override to select another switch OPAM_SWITCH: "base" @@ -88,12 +88,26 @@ after_script: - set +e +.dune-template: &dune-template + stage: build + artifacts: + name: "$CI_JOB_NAME" + paths: + - _build/ + expire_in: 1 week + script: + - set -e + - echo 'start:coq.dune' + - make -f Makefile.dune world + - echo 'end:coq.dune' + - set +e + # every non build job must set dependencies otherwise all build # artifacts are used together and we may get some random Coq. To that # purpose, we add a spurious dependency `not-a-real-job` that must be # overridden otherwise the CI will fail. -.doc-templare: &doc-template +.doc-template: &doc-template stage: test dependencies: - not-a-real-job @@ -203,6 +217,11 @@ build:edge+flambda: COQ_EXTRA_CONF: "-native-compiler yes -coqide opt -flambda-opts " COQ_EXTRA_CONF_QUOTE: "-O3 -unbox-closures" +build:egde:dune: + <<: *dune-template + variables: + OPAM_SWITCH: edge + windows64: <<: *windows-template variables: @@ -245,11 +264,23 @@ pkg:nix: paths: - nix-build-coq.drv-0/*/test-suite/logs -documentation: +doc:refman: <<: *doc-template dependencies: - build:base +doc:ml-api: + stage: test + dependencies: + - build:edge + script: + - ./configure -warn-error yes -prefix "$(pwd)/_install_ci" + - make mli-doc source-doc # ml-doc [broken in 4.07.0] + artifacts: + name: "$CI_JOB_NAME" + paths: + - dev/ocamldoc + test-suite:base: <<: *test-suite-template dependencies: diff --git a/.travis.yml b/.travis.yml index f8b047ea18..dd28410bec 100644 --- a/.travis.yml +++ b/.travis.yml @@ -40,7 +40,7 @@ env: # system is == 4.02.3 - COMPILER="system" - COMPILER_BE="4.07.0" - - DUNE_VER=".1.0.0" + - DUNE_VER=".1.1.1" - CAMLP5_VER=".6.14" - CAMLP5_VER_BE=".7.06" - FINDLIB_VER=".1.4.1" @@ -65,6 +65,33 @@ Standard Library - Added `Ndigits.N2Bv_sized`, and proved some lemmas about it. +- The scopes `int_scope` and `uint_scope` have been renamed to + `dec_int_scope` and `dec_uint_scope`, to clash less with ssreflect + and other packages. They are still delimited by `%int` and `%uint`. + +- Syntax notations for `string`, `ascii`, `Z`, `positive`, `N`, `R`, + and `int31` are no longer available merely by `Require`ing the files + that define the inductives. You must `Import` `Coq.Strings.String`, + `Coq.Strings.Ascii`, `Coq.ZArith.BinIntDef`, `Coq.PArith.BinPosDef`, + `Coq.NArith.BinNatDef`, `Coq.Reals.Rdefinitions`, and + `Coq.Numbers.Cyclic.Int31.Int31`, respectively, to be able to use + these notations. Note that passing `-compat 8.8` or issuing + `Require Import Coq.Compat.Coq88` will make these notations + available. Users wishing to port their developments automatically + may download `fix.py` from + <https://gist.github.com/JasonGross/5d4558edf8f5c2c548a3d96c17820169> + and run a command like `while true; do make -Okj 2>&1 | + /path/to/fix.py; done` and get a cup of coffee. (This command must + be manually interrupted once the build finishes all the way though. + Note also that this method is not fail-proof; you may have to adjust + some scopes if you were relying on string notations not being + available even when `string_scope` was open.) + +- Numeral syntax for `nat` is no longer available without loading the + entire prelude (`Require Import Coq.Init.Prelude`). This only + impacts users running Coq without the init library (`-nois` or + `-noinit`) and also issuing `Require Import Coq.Init.Datatypes`. + Tools - Coq_makefile lets one override or extend the following variables from @@ -82,6 +109,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 @@ -97,6 +125,8 @@ Vernacular Commands overwritting the opacity set of the hint database. - Added generic syntax for “attributes”, as in: `#[local] Lemma foo : bar.` +- Added the `Numeral Notation` command for registering decimal numeral + notations for custom types - The `Set SsrHave NoTCResolution` command no longer has special global scope. If you want the previous behavior, use `Global Set SsrHave NoTCResolution`. @@ -153,7 +183,16 @@ Notations 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). + 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 cd4a246bb4..de7fb9183c 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -50,6 +50,9 @@ 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`. @@ -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..0faa18b059 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 @@ -317,13 +317,11 @@ $(LIBCOQRUN): kernel/byterun/coq_jumptbl.h $(BYTERUN) cd $(dir $(LIBCOQRUN)) && \ $(OCAMLFIND) ocamlmklib -oc $(COQRUN) $(notdir $(BYTERUN)) -kernel/byterun/coq_jumptbl.h : kernel/byterun/coq_instruct.h - sed -n -e '/^ /s/ \([A-Z]\)/ \&\&coq_lbl_\1/gp' \ - -e '/^}/q' $< $(TOTARGET) +kernel/byterun/coq_jumptbl.h : kernel/byterun/coq_instruct.h kernel/byterun/make_jumptbl.sh + kernel/byterun/make_jumptbl.sh $< $@ -kernel/copcodes.ml: kernel/byterun/coq_instruct.h - tr -d "\r" < $< | sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' | \ - awk -f kernel/make-opcodes $(TOTARGET) +kernel/copcodes.ml: kernel/byterun/coq_instruct.h kernel/make_opcodes.sh kernel/make-opcodes + kernel/make_opcodes.sh $< $@ %.o: %.c $(SHOW)'OCAMLC $<' diff --git a/Makefile.ci b/Makefile.ci index 306471d1d0..e86504b76d 100644 --- a/Makefile.ci +++ b/Makefile.ci @@ -36,6 +36,7 @@ CI_TARGETS=ci-bedrock2 \ ci-pidetop \ ci-quickchick \ ci-sf \ + ci-simple-io \ ci-tlc \ ci-unimath \ ci-vst @@ -54,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.common b/Makefile.common index 772561bd70..09457ced7b 100644 --- a/Makefile.common +++ b/Makefile.common @@ -140,13 +140,12 @@ FOCMO:=plugins/firstorder/ground_plugin.cmo CCCMO:=plugins/cc/cc_plugin.cmo BTAUTOCMO:=plugins/btauto/btauto_plugin.cmo RTAUTOCMO:=plugins/rtauto/rtauto_plugin.cmo -NATSYNTAXCMO:=plugins/syntax/nat_syntax_plugin.cmo -OTHERSYNTAXCMO:=$(addprefix plugins/syntax/, \ - positive_syntax_plugin.cmo n_syntax_plugin.cmo \ - z_syntax_plugin.cmo r_syntax_plugin.cmo \ +SYNTAXCMO:=$(addprefix plugins/syntax/, \ + r_syntax_plugin.cmo \ int31_syntax_plugin.cmo \ ascii_syntax_plugin.cmo \ - string_syntax_plugin.cmo ) + string_syntax_plugin.cmo \ + numeral_notation_plugin.cmo) DERIVECMO:=plugins/derive/derive_plugin.cmo LTACCMO:=plugins/ltac/ltac_plugin.cmo plugins/ltac/tauto_plugin.cmo SSRMATCHINGCMO:=plugins/ssrmatching/ssrmatching_plugin.cmo @@ -156,7 +155,7 @@ PLUGINSCMO:=$(LTACCMO) $(OMEGACMO) $(ROMEGACMO) $(MICROMEGACMO) \ $(QUOTECMO) $(RINGCMO) \ $(EXTRACTIONCMO) \ $(CCCMO) $(FOCMO) $(RTAUTOCMO) $(BTAUTOCMO) \ - $(FUNINDCMO) $(NSATZCMO) $(NATSYNTAXCMO) $(OTHERSYNTAXCMO) \ + $(FUNINDCMO) $(NSATZCMO) $(SYNTAXCMO) \ $(DERIVECMO) $(SSRMATCHINGCMO) $(SSRCMO) ifeq ($(HASNATDYNLINK)-$(BEST),false-opt) diff --git a/Makefile.dev b/Makefile.dev index ea1a3d40a2..7fc1076a8f 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,27 +85,13 @@ 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 ############################### coqlight: theories-light tools coqbinaries -states: camldevfiles theories/Init/Prelude.vo +states: theories/Init/Prelude.vo miniopt: $(COQTOPEXE) pluginsopt minibyte: $(COQTOPBYTE) pluginsbyte diff --git a/Makefile.doc b/Makefile.doc index dde3a37b70..0dcf9daf27 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." @@ -214,9 +218,11 @@ ODOCDOTOPTS=-dot -dot-reduce source-doc: mli-doc $(OCAMLDOCDIR)/coq.pdf +OCAMLDOC_CAML_FLAGS=-rectypes -I +threads $(MLINCLUDES) + $(OCAMLDOCDIR)/coq.tex: $(DOCMLIS:.mli=.cmi) $(SHOW)'OCAMLDOC -latex -o $@' - $(HIDE)$(OCAMLFIND) ocamldoc -latex -rectypes -I $(MYCAMLP5LIB) $(MLINCLUDES)\ + $(HIDE)$(OCAMLFIND) ocamldoc -latex $(OCAMLDOC_CAML_FLAGS) \ $(DOCMLIS) -noheader -t "Coq mlis documentation" \ -intro $(OCAMLDOCDIR)/docintro -o $@.tmp $(SHOW)'OCAMLDOC utf8 fix' @@ -226,31 +232,31 @@ $(OCAMLDOCDIR)/coq.tex: $(DOCMLIS:.mli=.cmi) mli-doc: $(DOCMLIS:.mli=.cmi) $(SHOW)'OCAMLDOC -html' - $(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads -I $(MYCAMLP5LIB) $(MLINCLUDES) \ + $(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html $(OCAMLDOC_CAML_FLAGS) \ $(DOCMLIS) -d $(OCAMLDOCDIR)/html -colorize-code \ -t "Coq mlis documentation" -intro $(OCAMLDOCDIR)/docintro \ -css-style style.css ml-dot: $(MLFILES) - $(OCAMLFIND) ocamldoc -dot -dot-reduce -rectypes -I +threads -I $(CAMLLIB) -I $(MYCAMLP5LIB) $(MLINCLUDES) \ + $(OCAMLFIND) ocamldoc -dot -dot-reduce $(OCAMLDOC_CAML_FLAGS) \ $(filter $(addsuffix /%.ml,$(CORESRCDIRS)),$(MLFILES)) -o $(OCAMLDOCDIR)/coq.dot %_dep.png: %.dot $(DOT) -Tpng $< -o $@ %_types.dot: %.mli - $(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -dot-types -o $@ $< + $(OCAMLFIND) ocamldoc $(OCAMLDOC_CAML_FLAGS) $(ODOCDOTOPTS) -dot-types -o $@ $< -OCAMLDOC_MLLIBD = $(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ \ +OCAMLDOC_MLLIBD = $(OCAMLFIND) ocamldoc $(OCAMLDOC_CAML_FLAGS) $(ODOCDOTOPTS) -o $@ \ $(foreach lib,$(|:.mllib.d=_MLLIB_DEPENDENCIES),$(addsuffix .ml,$($(lib)))) %.dot: | %.mllib.d $(OCAMLDOC_MLLIBD) -ml-doc: +ml-doc: kernel/copcodes.cmi $(SHOW)'OCAMLDOC -html' $(HIDE)mkdir -p $(OCAMLDOCDIR)/html/implementation - $(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads $(MLINCLUDES) $(COQIDEFLAGS) \ + $(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html $(OCAMLDOC_CAML_FLAGS) \ $(DOCMLS) -d $(OCAMLDOCDIR)/html/implementation -colorize-code \ -t "Coq mls documentation" \ -css-style ../style.css @@ -265,7 +271,7 @@ tactics/tactics.dot: | tactics/tactics.mllib.d ltac/ltac.mllib.d $(OCAMLDOC_MLLIBD) %.dot: %.mli - $(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ $< + $(OCAMLFIND) ocamldoc $(OCAMLDOC_CAML_FLAGS) $(ODOCDOTOPTS) -o $@ $< $(OCAMLDOCDIR)/%.pdf: $(OCAMLDOCDIR)/%.tex $(SHOW)'PDFLATEX $*.tex' diff --git a/Makefile.dune b/Makefile.dune new file mode 100644 index 0000000000..6056151c0d --- /dev/null +++ b/Makefile.dune @@ -0,0 +1,39 @@ +# -*- mode: makefile -*- +# Dune Makefile for Coq + +.PHONY: help voboot states world apidoc + +# use DUNEOPT=--display=short for a more verbose build +# DUNEOPT=--display=short + +BUILD_CONTEXT=_build/default + +help: + @echo "Welcome to Coq's Dune-based build system. Targets are:" + @echo " - states: build a minimal functional coqtop" + @echo " - world: build all binaries and libraries" + @echo " - clean: remove build directory and autogenerated files" + @echo " - help: show this message" + +voboot: + dune build $(DUNEOPT) @vodeps + dune exec coq_dune $(BUILD_CONTEXT)/.vfiles.d + +states: voboot + dune build $(DUNEOPT) theories/Init/Prelude.vo + +world: voboot + dune build $(DUNEOPT) @install + +clean: + dune clean + +# Other common dev targets +# +# dune build coq.install +# dune build ide/coqide.install + +# Packaging / OPAM targets: +# +# dune -p coq @install +# dune -p coqide @install diff --git a/checker/cic.mli b/checker/cic.mli index df747692a4..17259bb438 100644 --- a/checker/cic.mli +++ b/checker/cic.mli @@ -220,6 +220,7 @@ type typing_flags = { points are assumed to be total. *) check_universes : bool; (** If [false] universe constraints are not checked *) conv_oracle : oracle; (** Unfolding strategies for conversion *) + share_reduction : bool; (** Use by-need reduction algorithm *) } type constant_body = { diff --git a/checker/dune b/checker/dune new file mode 100644 index 0000000000..d918f853dd --- /dev/null +++ b/checker/dune @@ -0,0 +1,26 @@ +(rule (copy %{project_root}/kernel/names.ml names.ml)) +(rule (copy %{project_root}/kernel/names.mli names.mli)) +(rule (copy %{project_root}/kernel/esubst.ml esubst.ml)) +(rule (copy %{project_root}/kernel/esubst.mli esubst.mli)) + +(library + (name checker) + (public_name coq.checker) + (synopsis "Coq's Standalone Proof Checker") + (modules values analyze names esubst) + (wrapped false) + (libraries coq.lib)) + +(executable + (name main) + (public_name coqchk) + (modules :standard \ votour values analyze names esubst) + (modules_without_implementation cic) + (libraries coq.checker)) + +(executable + (name votour) + (public_name votour) + (modules votour) + (libraries coq.checker)) + diff --git a/checker/values.ml b/checker/values.ml index e68cd18b87..e1b5a949ac 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -15,7 +15,7 @@ To ensure this file is up-to-date, 'make' now compares the md5 of cic.mli with a copy we maintain here: -MD5 064cd8d9651d37aebf77fb638b889cad checker/cic.mli +MD5 f7b267579138eabf86a74d6f2a7ed794 checker/cic.mli *) @@ -226,7 +226,7 @@ let v_cst_def = [|[|Opt Int|]; [|v_cstr_subst|]; [|v_lazy_constr|]|] let v_typing_flags = - v_tuple "typing_flags" [|v_bool; v_bool; v_oracle|] + v_tuple "typing_flags" [|v_bool; v_bool; v_oracle; v_bool|] let v_const_univs = v_sum "constant_universes" 0 [|[|v_context_set|]; [|v_abs_context|]|] diff --git a/clib/cList.mli b/clib/cList.mli index ed468cb977..39d9a5e535 100644 --- a/clib/cList.mli +++ b/clib/cList.mli @@ -289,8 +289,8 @@ sig val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list (** [share_tails l1 l2] returns [(l1',l2',l)] such that [l1] is - [l1'@l] and [l2] is [l2'@l] and [l] is maximal amongst all such - decompositions*) + [l1'\@l] and [l2] is [l2'\@l] and [l] is maximal amongst all such + decompositions *) (** {6 Association lists} *) diff --git a/clib/dune b/clib/dune new file mode 100644 index 0000000000..689a955ab7 --- /dev/null +++ b/clib/dune @@ -0,0 +1,8 @@ +(library + (name clib) + (synopsis "Coq's Utility Library [general purpose]") + (public_name coq.clib) + (wrapped false) + (modules_without_implementation cSig) + (libraries threads str unix dynlink)) + diff --git a/config/dune b/config/dune new file mode 100644 index 0000000000..30faf1233e --- /dev/null +++ b/config/dune @@ -0,0 +1,13 @@ +(library + (name config) + (synopsis "Coq Configuration Variables") + (public_name coq.config) + (wrapped false)) + +; Dune doesn't use configure's output, but it is still necessary for +; some Coq files to work; will be fixed in the future. +(rule + (targets coq_config.ml) + (mode fallback) + (deps %{project_root}/configure.ml %{project_root}/dev/ocamldebug-coq.run) + (action (chdir %{project_root} (run %{ocaml} configure.ml -local -warn-error yes -native-compiler yes)))) 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/coq.opam b/coq.opam new file mode 100644 index 0000000000..7f577dd8be --- /dev/null +++ b/coq.opam @@ -0,0 +1,22 @@ +opam-version: "1.2" +maintainer: "The Coq development team <coqdev@inria.fr>" +authors: "The Coq development team, INRIA, CNRS, and contributors." +homepage: "https://coq.inria.fr/" +bug-reports: "https://github.com/coq/coq/issues" +dev-repo: "https://github.com/coq/coq.git" +license: "LGPL-2.1" + +available: [ ocaml-version >= "4.02.3" ] + +depends: [ + "dune" { build } + "ocamlfind" { build } + "num" + "camlp5" +] + +build: [ + [ "dune" "build" "@vodeps" ] + [ "dune" "exec" "coq_dune" "_build/default/.vfiles.d" ] + [ "dune" "build" "-p" package "-j" jobs ] +] diff --git a/coqpp/coqpp_main.ml b/coqpp/coqpp_main.ml index fd425ef4ff..1648167a27 100644 --- a/coqpp/coqpp_main.ml +++ b/coqpp/coqpp_main.ml @@ -181,7 +181,7 @@ let print_fun fmt (vars, body) = in let () = fprintf fmt "fun@ " in let () = List.iter iter vars in - (** FIXME: use Coq locations in the macros *) + (* FIXME: use Coq locations in the macros *) let () = fprintf fmt "loc ->@ @[%s@]" body.code in () diff --git a/coqpp/dune b/coqpp/dune new file mode 100644 index 0000000000..24b9b9184b --- /dev/null +++ b/coqpp/dune @@ -0,0 +1,8 @@ +(ocamllex coqpp_lex) +(ocamlyacc coqpp_parse) + +(executable + (name coqpp_main) + (public_name coqpp) + (modules coqpp_ast coqpp_lex coqpp_parse coqpp_main) + (modules_without_implementation coqpp_ast)) diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh index 521dfe2a3f..8a49b97dac 100644 --- a/dev/build/windows/makecoq_mingw.sh +++ b/dev/build/windows/makecoq_mingw.sh @@ -1387,12 +1387,12 @@ function make_coq_installer { # Provides BigN, BigZ, BigQ that used to be part of Coq standard library function make_addon_bignums { - bignums_SHA=$(git ls-remote "$bignums_CI_GITURL" "refs/heads/$bignums_CI_BRANCH" | cut -f 1) + bignums_SHA=$(git ls-remote "$bignums_CI_GITURL" "refs/heads/$bignums_CI_REF" | cut -f 1) if [[ "$bignums_SHA" == "" ]]; then - # $bignums_CI_BRANCH must have been a tag and not a branch - bignums_SHA="$bignums_CI_BRANCH" + # $bignums_CI_REF must have been a tag / commit and not a branch + bignums_SHA="$bignums_CI_REF" fi - if build_prep "${bignums_CI_GITURL}/archive" "$bignums_SHA" zip 1 "bignums-$bignums_SHA"; then + if build_prep "$bignums_CI_ARCHIVEURL" "$bignums_SHA" zip 1 "bignums-$bignums_SHA"; then # To make command lines shorter :-( echo 'COQ_SRC_SUBDIRS:=$(filter-out plugins/%,$(COQ_SRC_SUBDIRS)) plugins/syntax' >> Makefile.coq.local log1 make all @@ -1405,12 +1405,12 @@ function make_addon_bignums { # A new (experimental) tactic language function make_addon_ltac2 { - ltac2_SHA=$(git ls-remote "$ltac2_CI_GITURL" "refs/heads/$ltac2_CI_BRANCH" | cut -f 1) + ltac2_SHA=$(git ls-remote "$ltac2_CI_GITURL" "refs/heads/$ltac2_CI_REF" | cut -f 1) if [[ "$ltac2_SHA" == "" ]]; then - # $ltac2_CI_BRANCH must have been a tag and not a branch - ltac2_SHA="$ltac2_CI_BRANCH" + # $ltac2_CI_REF must have been a tag / commit and not a branch + ltac2_SHA="$ltac2_CI_REF" fi - if build_prep "${ltac2_CI_GITURL}/archive" "$ltac2_SHA" zip 1 "ltac2-$ltac2_SHA"; then + if build_prep "$ltac2_CI_ARCHIVEURL" "$ltac2_SHA" zip 1 "ltac2-$ltac2_SHA"; then log1 make all log2 make install build_post @@ -1421,12 +1421,12 @@ function make_addon_ltac2 { # A function definition plugin function make_addon_equations { - Equations_SHA=$(git ls-remote "$Equations_CI_GITURL" "refs/heads/$Equations_CI_BRANCH" | cut -f 1) + Equations_SHA=$(git ls-remote "$Equations_CI_GITURL" "refs/heads/$Equations_CI_REF" | cut -f 1) if [[ "$Equations_SHA" == "" ]]; then - # $Equations_CI_BRANCH must have been a tag and not a branch - Equations_SHA="$Equations_CI_BRANCH" + # $Equations_CI_REF must have been a tag / commit and not a branch + Equations_SHA="$Equations_CI_REF" fi - if build_prep "${Equations_CI_GITURL}/archive" "$Equations_SHA" zip 1 "Equations-$Equations_SHA"; then + if build_prep "$Equations_CI_ARCHIVEURL" "$Equations_SHA" zip 1 "Equations-$Equations_SHA"; then # Note: PATH is autmatically saved/restored by build_prep / build_post PATH=$COQBIN:$PATH logn coq_makefile ${COQBIN}coq_makefile -f _CoqProject -o Makefile @@ -1448,10 +1448,10 @@ function make_addons { export CI_BRANCH="" export CI_PULL_REQUEST="" fi - . /build/ci-basic-overlay.sh for overlay in /build/user-overlays/*.sh; do . "$overlay" done + . /build/ci-basic-overlay.sh for addon in $COQ_ADDONS; do "make_addon_$addon" diff --git a/dev/ci/README.md b/dev/ci/README.md index a814e4914e..95892ebe0a 100644 --- a/dev/ci/README.md +++ b/dev/ci/README.md @@ -136,12 +136,38 @@ rebuilding Coq. In one job, Coq is built with `./configure -prefix _install_ci` and `make install` is run, then the `_install_ci` directory persists to and is used by the next jobs. -Artifacts can also be downloaded from the GitLab repository. -Currently, available artifacts are: +### Artifacts + +Build artifacts from GitLab can be linked / downloaded in a systematic +way, see [GitLab's documentation](https://docs.gitlab.com/ce/user/project/pipelines/job_artifacts.html#downloading-the-latest-job-artifacts) +for more information. For example, to access the documentation of the +`master` branch, you can do: + +https://gitlab.com/coq/coq/-/jobs/artifacts/master/file/_install_ci/share/doc/coq/sphinx/html/index.html?job=doc:refman + +Browsing artifacts is also possible: +https://gitlab.com/coq/coq/-/jobs/artifacts/master/browse/_install_ci/?job=build:base + +Above, you can replace `master` and `job` by the desired GitLab branch and job name. + +Currently available artifacts are: + - the Coq executables and stdlib, in four copies varying in - architecture and OCaml version used to build Coq. -- the Coq documentation, built in the `documentation` job. When submitting - a documentation PR, this can help reviewers checking the rendered result. + architecture and OCaml version used to build Coq: + https://gitlab.com/coq/coq/-/jobs/artifacts/master/browse/_install_ci/?job=build:base + + Additionally, an experimental Dune build is provided: + https://gitlab.com/coq/coq/-/jobs/artifacts/master/browse/_build/?job=build:edge:dune + +- the Coq documentation, built in the `doc:*` jobs. When submitting + a documentation PR, this can help reviewers checking the rendered result: + + + Coq's Reference Manual [master branch] + https://gitlab.com/coq/coq/-/jobs/artifacts/master/file/_install_ci/share/doc/coq/sphinx/html/index.html?job=doc:refman + + Coq's Standard Library Documentation [master branch] + https://gitlab.com/coq/coq/-/jobs/artifacts/master/file/_install_ci/share/doc/coq/html/stdlib/index.html?job=doc:refman + + Coq's ML API Documentation [master branch] + https://gitlab.com/coq/coq/-/jobs/artifacts/master/file/dev/ocamldoc/html/index.html?job=doc:ml-api ### GitLab and Windows @@ -168,6 +194,6 @@ but if you wish to save more time you can skip the job by setting This means you will need to change its value when the Docker image needs to be updated. You can do so for a single pipeline by starting -it through the web interface.. +it through the web interface. See also [`docker/README.md`](docker/README.md). diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh index 28321d13e2..63d5541f48 100755 --- a/dev/ci/ci-basic-overlay.sh +++ b/dev/ci/ci-basic-overlay.sh @@ -9,124 +9,147 @@ ######################################################################## # MathComp ######################################################################## -: "${mathcomp_CI_BRANCH:=master}" +: "${mathcomp_CI_REF:=master}" : "${mathcomp_CI_GITURL:=https://github.com/math-comp/math-comp}" -: "${oddorder_CI_BRANCH:=master}" +: "${mathcomp_CI_ARCHIVEURL:=${mathcomp_CI_GITURL}/archive}" + +: "${oddorder_CI_REF:=master}" : "${oddorder_CI_GITURL:=https://github.com/math-comp/odd-order}" +: "${oddorder_CI_ARCHIVEURL:=${oddorder_CI_GITURL}/archive}" ######################################################################## # UniMath ######################################################################## -: "${UniMath_CI_BRANCH:=master}" +: "${UniMath_CI_REF:=master}" : "${UniMath_CI_GITURL:=https://github.com/UniMath/UniMath}" +: "${UniMath_CI_ARCHIVEURL:=${UniMath_CI_GITURL}/archive}" ######################################################################## # Unicoq + Mtac2 ######################################################################## -: "${unicoq_CI_BRANCH:=master}" +: "${unicoq_CI_REF:=master}" : "${unicoq_CI_GITURL:=https://github.com/unicoq/unicoq}" +: "${unicoq_CI_ARCHIVEURL:=${unicoq_CI_GITURL}/archive}" -: "${mtac2_CI_BRANCH:=master-sync}" +: "${mtac2_CI_REF:=master-sync}" : "${mtac2_CI_GITURL:=https://github.com/Mtac2/Mtac2}" +: "${mtac2_CI_ARCHIVEURL:=${mtac2_CI_GITURL}/archive}" ######################################################################## # Mathclasses + Corn ######################################################################## -: "${math_classes_CI_BRANCH:=master}" -: "${math_classes_CI_GITURL:=https://github.com/math-classes/math-classes}" +: "${math_classes_CI_REF:=master}" +: "${math_classes_CI_GITURL:=https://github.com/coq-community/math-classes}" +: "${math_classes_CI_ARCHIVEURL:=${math_classes_CI_GITURL}/archive}" -: "${Corn_CI_BRANCH:=master}" -: "${Corn_CI_GITURL:=https://github.com/c-corn/corn}" +: "${Corn_CI_REF:=master}" +: "${Corn_CI_GITURL:=https://github.com/coq-community/corn}" +: "${Corn_CI_ARCHIVEURL:=${Corn_CI_GITURL}/archive}" ######################################################################## # Iris ######################################################################## -: "${stdpp_CI_BRANCH:=master}" +: "${stdpp_CI_REF:=master}" : "${stdpp_CI_GITURL:=https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp}" +: "${stdpp_CI_ARCHIVEURL:=${stdpp_CI_GITURL}/-/archive}" -: "${Iris_CI_BRANCH:=master}" +: "${Iris_CI_REF:=master}" : "${Iris_CI_GITURL:=https://gitlab.mpi-sws.org/FP/iris-coq}" +: "${Iris_CI_ARCHIVEURL:=${Iris_CI_GITURL}/-/archive}" -: "${lambdaRust_CI_BRANCH:=master}" +: "${lambdaRust_CI_REF:=master}" : "${lambdaRust_CI_GITURL:=https://gitlab.mpi-sws.org/FP/LambdaRust-coq}" +: "${lambdaRust_CI_ARCHIVEURL:=${lambdaRust_CI_GITURL}/-/archive}" ######################################################################## # HoTT ######################################################################## -: "${HoTT_CI_BRANCH:=master}" +: "${HoTT_CI_REF:=master}" : "${HoTT_CI_GITURL:=https://github.com/HoTT/HoTT}" +: "${HoTT_CI_ARCHIVEURL:=${HoTT_CI_GITURL}/archive}" ######################################################################## # Ltac2 ######################################################################## -: "${ltac2_CI_BRANCH:=master}" +: "${ltac2_CI_REF:=master}" : "${ltac2_CI_GITURL:=https://github.com/ppedrot/ltac2}" +: "${ltac2_CI_ARCHIVEURL:=${ltac2_CI_GITURL}/archive}" ######################################################################## # GeoCoq ######################################################################## -: "${GeoCoq_CI_BRANCH:=master}" +: "${GeoCoq_CI_REF:=master}" : "${GeoCoq_CI_GITURL:=https://github.com/GeoCoq/GeoCoq}" +: "${GeoCoq_CI_ARCHIVEURL:=${GeoCoq_CI_GITURL}/archive}" ######################################################################## # Flocq ######################################################################## -: "${Flocq_CI_BRANCH:=master}" +: "${Flocq_CI_REF:=master}" : "${Flocq_CI_GITURL:=https://gitlab.inria.fr/flocq/flocq}" +: "${Flocq_CI_ARCHIVEURL:=${Flocq_CI_GITURL}/-/archive}" ######################################################################## # Coquelicot ######################################################################## -: "${Coquelicot_CI_BRANCH:=master}" +: "${Coquelicot_CI_REF:=master}" : "${Coquelicot_CI_GITURL:=https://scm.gforge.inria.fr/anonscm/git/coquelicot/coquelicot}" ######################################################################## # CompCert ######################################################################## -: "${CompCert_CI_BRANCH:=master}" +: "${CompCert_CI_REF:=master}" : "${CompCert_CI_GITURL:=https://github.com/AbsInt/CompCert}" +: "${CompCert_CI_ARCHIVEURL:=${CompCert_CI_GITURL}/archive}" ######################################################################## # VST ######################################################################## -: "${VST_CI_BRANCH:=master}" +: "${VST_CI_REF:=master}" : "${VST_CI_GITURL:=https://github.com/PrincetonUniversity/VST}" +: "${VST_CI_ARCHIVEURL:=${VST_CI_GITURL}/archive}" ######################################################################## # cross-crypto ######################################################################## -: "${cross_crypto_CI_BRANCH:=master}" +: "${cross_crypto_CI_REF:=master}" : "${cross_crypto_CI_GITURL:=https://github.com/mit-plv/cross-crypto}" +: "${cross_crypto_CI_ARCHIVEURL:=${cross_crypto_CI_GITURL}/archive}" ######################################################################## # fiat_parsers ######################################################################## -: "${fiat_parsers_CI_BRANCH:=master}" +: "${fiat_parsers_CI_REF:=master}" : "${fiat_parsers_CI_GITURL:=https://github.com/mit-plv/fiat}" +: "${fiat_parsers_CI_ARCHIVEURL:=${fiat_parsers_CI_GITURL}/archive}" ######################################################################## # fiat_crypto ######################################################################## -: "${fiat_crypto_CI_BRANCH:=master}" +: "${fiat_crypto_CI_REF:=master}" : "${fiat_crypto_CI_GITURL:=https://github.com/mit-plv/fiat-crypto}" +: "${fiat_crypto_CI_ARCHIVEURL:=${fiat_crypto_CI_GITURL}/archive}" ######################################################################## # formal-topology ######################################################################## -: "${formal_topology_CI_BRANCH:=ci}" +: "${formal_topology_CI_REF:=ci}" : "${formal_topology_CI_GITURL:=https://github.com/bmsherman/topology}" +: "${formal_topology_CI_ARCHIVEURL:=${formal_topology_CI_GITURL}/archive}" ######################################################################## # coq-dpdgraph ######################################################################## -: "${coq_dpdgraph_CI_BRANCH:=coq-master}" +: "${coq_dpdgraph_CI_REF:=coq-master}" : "${coq_dpdgraph_CI_GITURL:=https://github.com/Karmaki/coq-dpdgraph}" +: "${coq_dpdgraph_CI_ARCHIVEURL:=${coq_dpdgraph_CI_GITURL}/archive}" ######################################################################## # CoLoR ######################################################################## -: "${CoLoR_CI_BRANCH:=master}" +: "${CoLoR_CI_REF:=master}" : "${CoLoR_CI_GITURL:=https://github.com/fblanqui/color}" +: "${CoLoR_CI_ARCHIVEURL:=${CoLoR_CI_GITURL}/archive}" ######################################################################## # SF @@ -138,53 +161,68 @@ ######################################################################## # TLC ######################################################################## -: "${tlc_CI_BRANCH:=master}" +: "${tlc_CI_REF:=master}" : "${tlc_CI_GITURL:=https://gforge.inria.fr/git/tlc/tlc}" ######################################################################## # Bignums ######################################################################## -: "${bignums_CI_BRANCH:=master}" +: "${bignums_CI_REF:=master}" : "${bignums_CI_GITURL:=https://github.com/coq/bignums}" +: "${bignums_CI_ARCHIVEURL:=${bignums_CI_GITURL}/archive}" ######################################################################## # bedrock2 ######################################################################## -: "${bedrock2_CI_BRANCH:=master}" +: "${bedrock2_CI_REF:=master}" : "${bedrock2_CI_GITURL:=https://github.com/mit-plv/bedrock2}" +: "${bedrock2_CI_ARCHIVEURL:=${bedrock2_CI_GITURL}/archive}" ######################################################################## # Equations ######################################################################## -: "${Equations_CI_BRANCH:=master}" +: "${Equations_CI_REF:=master}" : "${Equations_CI_GITURL:=https://github.com/mattam82/Coq-Equations}" +: "${Equations_CI_ARCHIVEURL:=${Equations_CI_GITURL}/archive}" ######################################################################## # Elpi ######################################################################## -: "${Elpi_CI_BRANCH:=coq-master}" +: "${Elpi_CI_REF:=coq-master}" : "${Elpi_CI_GITURL:=https://github.com/LPCIC/coq-elpi}" +: "${Elpi_CI_ARCHIVEURL:=${Elpi_CI_GITURL}/archive}" ######################################################################## # fcsl-pcm ######################################################################## -: "${fcsl_pcm_CI_BRANCH:=master}" +: "${fcsl_pcm_CI_REF:=master}" : "${fcsl_pcm_CI_GITURL:=https://github.com/imdea-software/fcsl-pcm}" +: "${fcsl_pcm_CI_ARCHIVEURL:=${fcsl_pcm_CI_GITURL}/archive}" ######################################################################## # pidetop ######################################################################## -: "${pidetop_CI_BRANCH:=v8.9}" +: "${pidetop_CI_REF:=v8.9}" : "${pidetop_CI_GITURL:=https://bitbucket.org/coqpide/pidetop}" +: "${pidetop_CI_ARCHIVEURL:=${pidetop_CI_GITURL}/get}" ######################################################################## # ext-lib ######################################################################## -: "${ext_lib_CI_BRANCH:=master}" +: "${ext_lib_CI_REF:=master}" : "${ext_lib_CI_GITURL:=https://github.com/coq-ext-lib/coq-ext-lib}" +: "${ext_lib_CI_ARCHIVEURL:=${ext_lib_CI_GITURL}/archive}" + +######################################################################## +# simple-io +######################################################################## +: "${simple_io_CI_REF:=master}" +: "${simple_io_CI_GITURL:=https://github.com/Lysxia/coq-simple-io}" +: "${simple_io_CI_ARCHIVEURL:=${simple_io_CI_GITURL}/archive}" ######################################################################## # quickchick ######################################################################## -: "${quickchick_CI_BRANCH:=master}" +: "${quickchick_CI_REF:=master}" : "${quickchick_CI_GITURL:=https://github.com/QuickChick/QuickChick}" +: "${quickchick_CI_ARCHIVEURL:=${quickchick_CI_GITURL}/archive}" diff --git a/dev/ci/ci-bedrock2.sh b/dev/ci/ci-bedrock2.sh index 447076e092..5205946261 100755 --- a/dev/ci/ci-bedrock2.sh +++ b/dev/ci/ci-bedrock2.sh @@ -3,9 +3,7 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -bedrock2_CI_DIR="${CI_BUILD_DIR}/bedrock2" +FORCE_GIT=1 +git_download bedrock2 -git_checkout "${bedrock2_CI_BRANCH}" "${bedrock2_CI_GITURL}" "${bedrock2_CI_DIR}" -( cd "${bedrock2_CI_DIR}" && git submodule update --init --recursive ) - -( cd "${bedrock2_CI_DIR}" && make ) +( cd "${CI_BUILD_DIR}/bedrock2" && git submodule update --init --recursive && make ) diff --git a/dev/ci/ci-bignums.sh b/dev/ci/ci-bignums.sh index 0082919679..756f54dfbd 100755 --- a/dev/ci/ci-bignums.sh +++ b/dev/ci/ci-bignums.sh @@ -1,16 +1,8 @@ #!/usr/bin/env bash ci_dir="$(dirname "$0")" +. "${ci_dir}/ci-common.sh" -# This script could be included inside other ones -# Let's avoid to source ci-common twice in this case -if [ -z "${CI_BUILD_DIR}" ]; -then - . "${ci_dir}/ci-common.sh" -fi +git_download bignums -bignums_CI_DIR="${CI_BUILD_DIR}/Bignums" - -git_checkout "${bignums_CI_BRANCH}" "${bignums_CI_GITURL}" "${bignums_CI_DIR}" - -( cd "${bignums_CI_DIR}" && make && make install) +( cd "${CI_BUILD_DIR}/bignums" && make && make install) diff --git a/dev/ci/ci-color.sh b/dev/ci/ci-color.sh index 8ce5f2418f..dc696f69d9 100755 --- a/dev/ci/ci-color.sh +++ b/dev/ci/ci-color.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -CoLoR_CI_DIR=${CI_BUILD_DIR}/color +git_download CoLoR -# Compile CoLoR -git_checkout "${CoLoR_CI_BRANCH}" "${CoLoR_CI_GITURL}" "${CoLoR_CI_DIR}" -( cd "${CoLoR_CI_DIR}" && make ) +( cd "${CI_BUILD_DIR}/CoLoR" && make ) diff --git a/dev/ci/ci-common.sh b/dev/ci/ci-common.sh index 9259a6e0c8..7af648f0a6 100644 --- a/dev/ci/ci-common.sh +++ b/dev/ci/ci-common.sh @@ -34,39 +34,48 @@ export COQBIN="$COQBIN/" ls "$COQBIN" -# Where we clone and build external developments +# Where we download and build external developments CI_BUILD_DIR="$PWD/_build_ci" -# shellcheck source=ci-basic-overlay.sh -. "${ci_dir}/ci-basic-overlay.sh" for overlay in "${ci_dir}"/user-overlays/*.sh; do # shellcheck source=/dev/null . "${overlay}" done +# shellcheck source=ci-basic-overlay.sh +. "${ci_dir}/ci-basic-overlay.sh" -mathcomp_CI_DIR="${CI_BUILD_DIR}/math-comp" - -# git_checkout branch url dest will create a git repository -# in <dest> (if it does not exist already) and checkout the -# remote branch <branch> from <url> -git_checkout() +# [git_download project] will download [project] and unpack it +# in [$CI_BUILD_DIR/project] if the folder does not exist already; +# if it does, it will do nothing except print a warning (this can be +# useful when building locally). +# Note: when $FORCE_GIT is set to 1 or when $CI is unset or empty +# (local build), it uses git clone to perform the download. +git_download() { - local _BRANCH=${1} - local _URL=${2} - local _DEST=${3} - - # Allow an optional 4th argument for the commit - local _COMMIT=${4:-FETCH_HEAD} - local _DEPTH=() - if [ -z "${4}" ]; then _DEPTH=(--depth 1); fi - - mkdir -p "${_DEST}" - ( cd "${_DEST}" && \ - if [ ! -d .git ] ; then git clone "${_DEPTH[@]}" "${_URL}" . ; fi && \ - echo "Checking out ${_DEST}" && \ - git fetch "${_URL}" "${_BRANCH}" && \ - git -c advice.detachedHead=false checkout "${_COMMIT}" && \ - echo "${_DEST}: $(git log -1 --format='%s | %H | %cd | %aN')" ) + local PROJECT=$1 + local DEST="$CI_BUILD_DIR/$PROJECT" + + if [ -d "$DEST" ]; then + echo "Warning: download and unpacking of $PROJECT skipped because $DEST already exists." + elif [ "$FORCE_GIT" = "1" ] || [ "$CI" = "" ]; then + local GITURL_VAR="${PROJECT}_CI_GITURL" + local GITURL="${!GITURL_VAR}" + local REF_VAR="${PROJECT}_CI_REF" + local REF="${!REF_VAR}" + git clone "$GITURL" "$DEST" + cd "$DEST" + git checkout "$REF" + else # When possible, we download tarballs to reduce bandwidth and latency + local ARCHIVEURL_VAR="${PROJECT}_CI_ARCHIVEURL" + local ARCHIVEURL="${!ARCHIVEURL_VAR}" + local REF_VAR="${PROJECT}_CI_REF" + local REF="${!REF_VAR}" + mkdir -p "$DEST" + cd "$DEST" + wget "$ARCHIVEURL/$REF.tar.gz" + tar xvfz "$REF.tar.gz" --strip-components=1 + rm -f "$REF.tar.gz" + fi } make() @@ -84,31 +93,27 @@ make() # this installs just the ssreflect library of math-comp install_ssreflect() { - echo 'Installing ssreflect' && echo -en 'travis_fold:start:ssr.install\\r' + echo 'Installing ssreflect' - git_checkout "${mathcomp_CI_BRANCH}" "${mathcomp_CI_GITURL}" "${mathcomp_CI_DIR}" + git_download mathcomp - ( cd "${mathcomp_CI_DIR}/mathcomp" && \ + ( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" && \ make Makefile.coq && \ make -f Makefile.coq ssreflect/all_ssreflect.vo && \ make -f Makefile.coq install ) - echo -en 'travis_fold:end:ssr.install\\r' - } # this installs just the ssreflect + algebra library of math-comp install_ssralg() { - echo 'Installing ssralg' && echo -en 'travis_fold:start:ssralg.install\\r' + echo 'Installing ssralg' - git_checkout "${mathcomp_CI_BRANCH}" "${mathcomp_CI_GITURL}" "${mathcomp_CI_DIR}" + git_download mathcomp - ( cd "${mathcomp_CI_DIR}/mathcomp" && \ + ( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" && \ make Makefile.coq && \ make -f Makefile.coq algebra/all_algebra.vo && \ make -f Makefile.coq install ) - echo -en 'travis_fold:end:ssralg.install\\r' - } diff --git a/dev/ci/ci-compcert.sh b/dev/ci/ci-compcert.sh index 8d490591b6..01c35ceb4a 100755 --- a/dev/ci/ci-compcert.sh +++ b/dev/ci/ci-compcert.sh @@ -3,8 +3,7 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -CompCert_CI_DIR="${CI_BUILD_DIR}/CompCert" +git_download CompCert -git_checkout "${CompCert_CI_BRANCH}" "${CompCert_CI_GITURL}" "${CompCert_CI_DIR}" - -( cd "${CompCert_CI_DIR}" && ./configure -ignore-coq-version x86_32-linux && make && make check-proof ) +( cd "${CI_BUILD_DIR}/CompCert" && \ + ./configure -ignore-coq-version x86_32-linux && make && make check-proof ) diff --git a/dev/ci/ci-coq-dpdgraph.sh b/dev/ci/ci-coq-dpdgraph.sh index 5d57fce1c7..2373ea6c62 100755 --- a/dev/ci/ci-coq-dpdgraph.sh +++ b/dev/ci/ci-coq-dpdgraph.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -coq_dpdgraph_CI_DIR="${CI_BUILD_DIR}/coq-dpdgraph" +git_download coq_dpdgraph -git_checkout "${coq_dpdgraph_CI_BRANCH}" "${coq_dpdgraph_CI_GITURL}" "${coq_dpdgraph_CI_DIR}" - -( cd "${coq_dpdgraph_CI_DIR}" && autoconf && ./configure && make && make test-suite ) +( cd "${CI_BUILD_DIR}/coq_dpdgraph" && autoconf && ./configure && make && make test-suite ) diff --git a/dev/ci/ci-coquelicot.sh b/dev/ci/ci-coquelicot.sh index d86d61ef6a..5d8817491d 100755 --- a/dev/ci/ci-coquelicot.sh +++ b/dev/ci/ci-coquelicot.sh @@ -3,10 +3,9 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -Coquelicot_CI_DIR="${CI_BUILD_DIR}/coquelicot" - install_ssreflect -git_checkout "${Coquelicot_CI_BRANCH}" "${Coquelicot_CI_GITURL}" "${Coquelicot_CI_DIR}" +FORCE_GIT=1 +git_download Coquelicot -( cd "${Coquelicot_CI_DIR}" && ./autogen.sh && ./configure && ./remake "-j${NJOBS}" ) +( cd "${CI_BUILD_DIR}/Coquelicot" && ./autogen.sh && ./configure && ./remake "-j${NJOBS}" ) diff --git a/dev/ci/ci-corn.sh b/dev/ci/ci-corn.sh index 9298fc70af..7d5d70cf90 100755 --- a/dev/ci/ci-corn.sh +++ b/dev/ci/ci-corn.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -Corn_CI_DIR="${CI_BUILD_DIR}/corn" +git_download Corn -git_checkout "${Corn_CI_BRANCH}" "${Corn_CI_GITURL}" "${Corn_CI_DIR}" - -( cd "${Corn_CI_DIR}" && make && make install ) +( cd "${CI_BUILD_DIR}/Corn" && make && make install ) diff --git a/dev/ci/ci-cross-crypto.sh b/dev/ci/ci-cross-crypto.sh index a0d3aa6551..900d12c1dd 100755 --- a/dev/ci/ci-cross-crypto.sh +++ b/dev/ci/ci-cross-crypto.sh @@ -3,9 +3,7 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -cross_crypto_CI_DIR="${CI_BUILD_DIR}/cross-crypto" +FORCE_GIT=1 +git_download cross_crypto -git_checkout "${cross_crypto_CI_BRANCH}" "${cross_crypto_CI_GITURL}" "${cross_crypto_CI_DIR}" -( cd "${cross_crypto_CI_DIR}" && git submodule update --init --recursive ) - -( cd "${cross_crypto_CI_DIR}" && make ) +( cd "${CI_BUILD_DIR}/cross_crypto" && git submodule update --init --recursive && make ) diff --git a/dev/ci/ci-elpi.sh b/dev/ci/ci-elpi.sh index 9c58034be1..9b4a06fd5b 100755 --- a/dev/ci/ci-elpi.sh +++ b/dev/ci/ci-elpi.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -Elpi_CI_DIR="${CI_BUILD_DIR}/elpi" +git_download Elpi -git_checkout "${Elpi_CI_BRANCH}" "${Elpi_CI_GITURL}" "${Elpi_CI_DIR}" - -( cd "${Elpi_CI_DIR}" && make && make install ) +( cd "${CI_BUILD_DIR}/Elpi" && make && make install ) diff --git a/dev/ci/ci-equations.sh b/dev/ci/ci-equations.sh index 98735b4ec4..998d50faa7 100755 --- a/dev/ci/ci-equations.sh +++ b/dev/ci/ci-equations.sh @@ -3,8 +3,7 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -Equations_CI_DIR="${CI_BUILD_DIR}/Equations" +git_download Equations -git_checkout "${Equations_CI_BRANCH}" "${Equations_CI_GITURL}" "${Equations_CI_DIR}" - -( cd "${Equations_CI_DIR}" && coq_makefile -f _CoqProject -o Makefile && make && make test-suite && make examples && make install) +( cd "${CI_BUILD_DIR}/Equations" && coq_makefile -f _CoqProject -o Makefile && \ + make && make test-suite && make examples && make install) diff --git a/dev/ci/ci-ext-lib.sh b/dev/ci/ci-ext-lib.sh index cf212c2fb5..5eb167d97d 100755 --- a/dev/ci/ci-ext-lib.sh +++ b/dev/ci/ci-ext-lib.sh @@ -1,16 +1,8 @@ #!/usr/bin/env bash ci_dir="$(dirname "$0")" +. "${ci_dir}/ci-common.sh" -# This script could be included inside other ones -# Let's avoid to source ci-common twice in this case -if [ -z "${CI_BUILD_DIR}" ]; -then - . "${ci_dir}/ci-common.sh" -fi +git_download ext_lib -ext_lib_CI_DIR="${CI_BUILD_DIR}/ExtLib" - -git_checkout "${ext_lib_CI_BRANCH}" "${ext_lib_CI_GITURL}" "${ext_lib_CI_DIR}" - -( cd "${ext_lib_CI_DIR}" && make && make install) +( cd "${CI_BUILD_DIR}/ext_lib" && make && make install) diff --git a/dev/ci/ci-fcsl-pcm.sh b/dev/ci/ci-fcsl-pcm.sh index fdc4c729b6..cb951630c8 100755 --- a/dev/ci/ci-fcsl-pcm.sh +++ b/dev/ci/ci-fcsl-pcm.sh @@ -3,10 +3,8 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -fcsl_pcm_CI_DIR="${CI_BUILD_DIR}/fcsl-pcm" - install_ssreflect -git_checkout "${fcsl_pcm_CI_BRANCH}" "${fcsl_pcm_CI_GITURL}" "${fcsl_pcm_CI_DIR}" +git_download fcsl_pcm -( cd "${fcsl_pcm_CI_DIR}" && make ) +( cd "${CI_BUILD_DIR}/fcsl_pcm" && make ) diff --git a/dev/ci/ci-fiat-crypto-legacy.sh b/dev/ci/ci-fiat-crypto-legacy.sh index 9429344159..e0395754e5 100755 --- a/dev/ci/ci-fiat-crypto-legacy.sh +++ b/dev/ci/ci-fiat-crypto-legacy.sh @@ -3,12 +3,11 @@ 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 ) +FORCE_GIT=1 +git_download fiat_crypto 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} ) + +( cd "${CI_BUILD_DIR}/fiat_crypto" && git submodule update --init --recursive && \ + 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 659511dbea..7e8013be9b 100755 --- a/dev/ci/ci-fiat-crypto.sh +++ b/dev/ci/ci-fiat-crypto.sh @@ -3,10 +3,12 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -fiat_crypto_CI_DIR="${CI_BUILD_DIR}/fiat-crypto" +FORCE_GIT=1 +git_download fiat_crypto -git_checkout "${fiat_crypto_CI_BRANCH}" "${fiat_crypto_CI_GITURL}" "${fiat_crypto_CI_DIR}" +# 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}" && git submodule update --init --recursive ) - -( cd "${fiat_crypto_CI_DIR}" && make new-pipeline ) +( cd "${CI_BUILD_DIR}/fiat_crypto" && git submodule update --init --recursive && \ + ulimit -s 32768 && make new-pipeline c-files ) diff --git a/dev/ci/ci-fiat-parsers.sh b/dev/ci/ci-fiat-parsers.sh index 35c2284050..ac74ebf667 100755 --- a/dev/ci/ci-fiat-parsers.sh +++ b/dev/ci/ci-fiat-parsers.sh @@ -3,8 +3,7 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -fiat_parsers_CI_DIR="${CI_BUILD_DIR}/fiat" +FORCE_GIT=1 +git_download fiat_parsers -git_checkout "${fiat_parsers_CI_BRANCH}" "${fiat_parsers_CI_GITURL}" "${fiat_parsers_CI_DIR}" - -( cd "${fiat_parsers_CI_DIR}" && make parsers parsers-examples && make fiat-core ) +( cd "${CI_BUILD_DIR}/fiat_parsers" && make parsers parsers-examples && make fiat-core ) diff --git a/dev/ci/ci-flocq.sh b/dev/ci/ci-flocq.sh index 8599e4d50e..e87483df0a 100755 --- a/dev/ci/ci-flocq.sh +++ b/dev/ci/ci-flocq.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -Flocq_CI_DIR="${CI_BUILD_DIR}/flocq" +git_download Flocq -git_checkout "${Flocq_CI_BRANCH}" "${Flocq_CI_GITURL}" "${Flocq_CI_DIR}" - -( cd "${Flocq_CI_DIR}" && ./autogen.sh && ./configure && ./remake "-j${NJOBS}" ) +( cd "${CI_BUILD_DIR}/Flocq" && ./autogen.sh && ./configure && ./remake "-j${NJOBS}" ) diff --git a/dev/ci/ci-formal-topology.sh b/dev/ci/ci-formal-topology.sh index 118d151500..8be5a06ed2 100755 --- a/dev/ci/ci-formal-topology.sh +++ b/dev/ci/ci-formal-topology.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -formal_topology_CI_DIR="${CI_BUILD_DIR}/formal-topology" +git_download formal_topology -git_checkout "${formal_topology_CI_BRANCH}" "${formal_topology_CI_GITURL}" "${formal_topology_CI_DIR}" - -( cd "${formal_topology_CI_DIR}" && make ) +( cd "${CI_BUILD_DIR}/formal_topology" && make ) diff --git a/dev/ci/ci-geocoq.sh b/dev/ci/ci-geocoq.sh index 24cd9c4272..8c57318477 100755 --- a/dev/ci/ci-geocoq.sh +++ b/dev/ci/ci-geocoq.sh @@ -3,10 +3,8 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -GeoCoq_CI_DIR="${CI_BUILD_DIR}/GeoCoq" - -git_checkout "${GeoCoq_CI_BRANCH}" "${GeoCoq_CI_GITURL}" "${GeoCoq_CI_DIR}" - install_ssralg -( cd "${GeoCoq_CI_DIR}" && ./configure.sh && make ) +git_download GeoCoq + +( cd "${CI_BUILD_DIR}/GeoCoq" && ./configure.sh && make ) diff --git a/dev/ci/ci-hott.sh b/dev/ci/ci-hott.sh index 184b90a50b..7eeeb09372 100755 --- a/dev/ci/ci-hott.sh +++ b/dev/ci/ci-hott.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -HoTT_CI_DIR="${CI_BUILD_DIR}"/HoTT +git_download HoTT -git_checkout "${HoTT_CI_BRANCH}" "${HoTT_CI_GITURL}" "${HoTT_CI_DIR}" - -( cd "${HoTT_CI_DIR}" && ./autogen.sh && ./configure && make && make validate ) +( cd "${CI_BUILD_DIR}/HoTT" && ./autogen.sh && ./configure && make && make validate ) diff --git a/dev/ci/ci-iris-lambda-rust.sh b/dev/ci/ci-iris-lambda-rust.sh index 1af0f634c4..6960a8b98a 100755 --- a/dev/ci/ci-iris-lambda-rust.sh +++ b/dev/ci/ci-iris-lambda-rust.sh @@ -3,32 +3,28 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -stdpp_CI_DIR="${CI_BUILD_DIR}/coq-stdpp" -Iris_CI_DIR="${CI_BUILD_DIR}/iris-coq" -lambdaRust_CI_DIR="${CI_BUILD_DIR}/lambdaRust" - install_ssreflect # Setup lambdaRust first -git_checkout "${lambdaRust_CI_BRANCH}" "${lambdaRust_CI_GITURL}" "${lambdaRust_CI_DIR}" +git_download lambdaRust # Extract required version of Iris -Iris_SHA=$(grep -F coq-iris < "${lambdaRust_CI_DIR}/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') +Iris_REF=$(grep -F coq-iris < "${CI_BUILD_DIR}/lambdaRust/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') # Setup Iris -git_checkout "${Iris_CI_BRANCH}" "${Iris_CI_GITURL}" "${Iris_CI_DIR}" "${Iris_SHA}" +git_download Iris # Extract required version of std++ -stdpp_SHA=$(grep -F coq-stdpp < "${Iris_CI_DIR}/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') +stdpp_REF=$(grep -F coq-stdpp < "${CI_BUILD_DIR}/Iris/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') # Setup std++ -git_checkout "${stdpp_CI_BRANCH}" "${stdpp_CI_GITURL}" "${stdpp_CI_DIR}" "${stdpp_SHA}" +git_download stdpp # Build std++ -( cd "${stdpp_CI_DIR}" && make && make install ) +( cd "${CI_BUILD_DIR}/stdpp" && make && make install ) -# Build and validate (except on Travis, i.e., skip if TRAVIS is non-empty) Iris -( cd "${Iris_CI_DIR}" && make && (test -n "${TRAVIS}" || make validate) && make install ) +# Build and validate Iris +( cd "${CI_BUILD_DIR}/Iris" && make && make validate && make install ) # Build lambdaRust -( cd "${lambdaRust_CI_DIR}" && make && make install ) +( cd "${CI_BUILD_DIR}/lambdaRust" && make && make install ) diff --git a/dev/ci/ci-ltac2.sh b/dev/ci/ci-ltac2.sh index 5981aaaae7..4df22bf249 100755 --- a/dev/ci/ci-ltac2.sh +++ b/dev/ci/ci-ltac2.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -ltac2_CI_DIR="${CI_BUILD_DIR}/ltac2" +git_download ltac2 -git_checkout "${ltac2_CI_BRANCH}" "${ltac2_CI_GITURL}" "${ltac2_CI_DIR}" - -( cd "${ltac2_CI_DIR}" && make && make tests && make install ) +( cd "${CI_BUILD_DIR}/ltac2" && make && make tests && make install ) diff --git a/dev/ci/ci-math-classes.sh b/dev/ci/ci-math-classes.sh index 6a064b2971..ae31a8e7f8 100755 --- a/dev/ci/ci-math-classes.sh +++ b/dev/ci/ci-math-classes.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -math_classes_CI_DIR="${CI_BUILD_DIR}/math-classes" +git_download math_classes -git_checkout "${math_classes_CI_BRANCH}" "${math_classes_CI_GITURL}" "${math_classes_CI_DIR}" - -( cd "${math_classes_CI_DIR}" && ./configure.sh && make && make install ) +( cd "${CI_BUILD_DIR}/math_classes" && ./configure.sh && make && make install ) diff --git a/dev/ci/ci-math-comp.sh b/dev/ci/ci-math-comp.sh index 20328baf2a..a74f9fa4d3 100755 --- a/dev/ci/ci-math-comp.sh +++ b/dev/ci/ci-math-comp.sh @@ -4,11 +4,10 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -mathcomp_CI_DIR="${CI_BUILD_DIR}/math-comp" -oddorder_CI_DIR="${CI_BUILD_DIR}/odd-order" +git_download mathcomp -git_checkout "${mathcomp_CI_BRANCH}" "${mathcomp_CI_GITURL}" "${mathcomp_CI_DIR}" -git_checkout "${oddorder_CI_BRANCH}" "${oddorder_CI_GITURL}" "${oddorder_CI_DIR}" +( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" && make && make install ) -( cd "${mathcomp_CI_DIR}/mathcomp" && make && make install ) -( cd "${oddorder_CI_DIR}/" && make ) +git_download oddorder + +( cd "${CI_BUILD_DIR}/oddorder" && make ) diff --git a/dev/ci/ci-mtac2.sh b/dev/ci/ci-mtac2.sh index 1372acb8e5..7075d4d7f6 100755 --- a/dev/ci/ci-mtac2.sh +++ b/dev/ci/ci-mtac2.sh @@ -3,17 +3,10 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -unicoq_CI_DIR=${CI_BUILD_DIR}/unicoq -mtac2_CI_DIR=${CI_BUILD_DIR}/Mtac2 +git_download unicoq -# Setup UniCoq +( cd "${CI_BUILD_DIR}/unicoq" && coq_makefile -f Make -o Makefile && make && make install ) -git_checkout "${unicoq_CI_BRANCH}" "${unicoq_CI_GITURL}" "${unicoq_CI_DIR}" +git_download mtac2 -( cd "${unicoq_CI_DIR}" && coq_makefile -f Make -o Makefile && make && make install ) - -# Setup MetaCoq - -git_checkout "${mtac2_CI_BRANCH}" "${mtac2_CI_GITURL}" "${mtac2_CI_DIR}" - -( cd "${mtac2_CI_DIR}" && coq_makefile -f _CoqProject -o Makefile && make ) +( cd "${CI_BUILD_DIR}/mtac2" && coq_makefile -f _CoqProject -o Makefile && make ) diff --git a/dev/ci/ci-pidetop.sh b/dev/ci/ci-pidetop.sh index 32cba0808e..1a9a26843c 100755 --- a/dev/ci/ci-pidetop.sh +++ b/dev/ci/ci-pidetop.sh @@ -1,12 +1,9 @@ #!/usr/bin/env bash -# $0 is not the safest way, but... ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -pidetop_CI_DIR="${CI_BUILD_DIR}/pidetop" - -git_checkout "${pidetop_CI_BRANCH}" "${pidetop_CI_GITURL}" "${pidetop_CI_DIR}" +git_download pidetop # Travis / Gitlab have different filesystem layout due to use of # `-local`. We need to improve this divergence but if we use Dune this @@ -17,6 +14,6 @@ else COQLIB="$COQBIN/../" fi -( cd "${pidetop_CI_DIR}" && jbuilder build @install ) +( cd "${CI_BUILD_DIR}/pidetop" && dune build -p pidetop @install ) -echo -en '4\nexit' | "$pidetop_CI_DIR/_build/install/default/bin/pidetop" -coqlib "$COQLIB" -main-channel stdfds +echo -en '4\nexit' | "${CI_BUILD_DIR}/pidetop/_build/install/default/bin/pidetop" -coqlib "$COQLIB" -main-channel stdfds diff --git a/dev/ci/ci-quickchick.sh b/dev/ci/ci-quickchick.sh index fc39e2685d..08686d7ced 100755 --- a/dev/ci/ci-quickchick.sh +++ b/dev/ci/ci-quickchick.sh @@ -1,18 +1,10 @@ #!/usr/bin/env bash ci_dir="$(dirname "$0")" - -# This script could be included inside other ones -# Let's avoid to source ci-common twice in this case -if [ -z "${CI_BUILD_DIR}" ]; -then - . "${ci_dir}/ci-common.sh" -fi - -quickchick_CI_DIR="${CI_BUILD_DIR}/Quickchick" +. "${ci_dir}/ci-common.sh" install_ssreflect -git_checkout "${quickchick_CI_BRANCH}" "${quickchick_CI_GITURL}" "${quickchick_CI_DIR}" +git_download quickchick -( cd "${quickchick_CI_DIR}" && make && make install) +( cd "${CI_BUILD_DIR}/quickchick" && make && make install) diff --git a/dev/ci/ci-simple-io.sh b/dev/ci/ci-simple-io.sh new file mode 100755 index 0000000000..e7bcd80de7 --- /dev/null +++ b/dev/ci/ci-simple-io.sh @@ -0,0 +1,8 @@ +#!/usr/bin/env bash + +ci_dir="$(dirname "$0")" +. "${ci_dir}/ci-common.sh" + +git_download simple_io + +( cd "${CI_BUILD_DIR}/simple_io" && make build && make install) diff --git a/dev/ci/ci-template.sh b/dev/ci/ci-template.sh deleted file mode 100755 index e77a553047..0000000000 --- a/dev/ci/ci-template.sh +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/env bash - -ci_dir="$(dirname "$0")" -. "${ci_dir}/ci-common.sh" - -Template_CI_BRANCH=master -Template_CI_GITURL=https://github.com/Template/Template -Template_CI_DIR="${CI_BUILD_DIR}/Template" - -git_checkout "${Template_CI_BRANCH}" "${Template_CI_GITURL}" "${Template_CI_DIR}" - -( cd "${Template_CI_DIR}" && make ) diff --git a/dev/ci/ci-tlc.sh b/dev/ci/ci-tlc.sh index 31387c8ddc..a2f0bea555 100755 --- a/dev/ci/ci-tlc.sh +++ b/dev/ci/ci-tlc.sh @@ -3,8 +3,7 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -tlc_CI_DIR="${CI_BUILD_DIR}/tlc" +FORCE_GIT=1 +git_download tlc -git_checkout "${tlc_CI_BRANCH}" "${tlc_CI_GITURL}" "${tlc_CI_DIR}" - -( cd "${tlc_CI_DIR}" && make ) +( cd "${CI_BUILD_DIR}/tlc" && make ) diff --git a/dev/ci/ci-unimath.sh b/dev/ci/ci-unimath.sh index aa20fe1ff0..a7644fee23 100755 --- a/dev/ci/ci-unimath.sh +++ b/dev/ci/ci-unimath.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -UniMath_CI_DIR="${CI_BUILD_DIR}/UniMath" +git_download UniMath -git_checkout "${UniMath_CI_BRANCH}" "${UniMath_CI_GITURL}" "${UniMath_CI_DIR}" - -( cd "${UniMath_CI_DIR}" && make BUILD_COQ=no ) +( cd "${CI_BUILD_DIR}/UniMath" && make BUILD_COQ=no ) diff --git a/dev/ci/ci-vst.sh b/dev/ci/ci-vst.sh index 7a097eaab4..0fec19205a 100755 --- a/dev/ci/ci-vst.sh +++ b/dev/ci/ci-vst.sh @@ -3,8 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -VST_CI_DIR="${CI_BUILD_DIR}/VST" +git_download VST -git_checkout "${VST_CI_BRANCH}" "${VST_CI_GITURL}" "${VST_CI_DIR}" - -( cd "${VST_CI_DIR}" && make IGNORECOQVERSION=true ) +( cd "${CI_BUILD_DIR}/VST" && make IGNORECOQVERSION=true ) diff --git a/dev/ci/docker/bionic_coq/Dockerfile b/dev/ci/docker/bionic_coq/Dockerfile index 1361392dc8..7a649591dd 100644 --- a/dev/ci/docker/bionic_coq/Dockerfile +++ b/dev/ci/docker/bionic_coq/Dockerfile @@ -1,4 +1,4 @@ -# CACHEKEY: "bionic_coq-V2018-07-11-V2" +# CACHEKEY: "bionic_coq-V2018-08-27-V2" # ^^ Update when modifying this file. FROM ubuntu:bionic @@ -28,8 +28,8 @@ RUN opam init -a -y -j $NJOBS --compiler="$COMPILER" default https://opam.ocaml. # Common OPAM packages. # `num` does not have a version number as the right version to install varies # with the compiler version. -ENV BASE_OPAM="num ocamlfind.1.8.0 dune.1.0.0 ounit.2.0.8" \ - CI_OPAM="menhir.20180530 elpi.1.0.4 ocamlgraph.1.8.8" +ENV BASE_OPAM="num ocamlfind.1.8.0 dune.1.1.1 ounit.2.0.8" \ + CI_OPAM="menhir.20180530 elpi.1.0.5 ocamlgraph.1.8.8" # BASE switch; CI_OPAM contains Coq's CI dependencies. ENV CAMLP5_VER="6.14" \ diff --git a/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh b/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh index e6a2c4460b..d812df3ec0 100644 --- a/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh +++ b/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh @@ -1,6 +1,6 @@ #!/bin/sh if [ "$CI_PULL_REQUEST" = "669" ] || [ "$CI_BRANCH" = "ssr-merge" ]; then - mathcomp_CI_BRANCH=ssr-merge + mathcomp_CI_REF=ssr-merge mathcomp_CI_GITURL=https://github.com/maximedenes/math-comp fi diff --git a/dev/ci/user-overlays/07085-ppedrot-pure-sharing-flag.sh b/dev/ci/user-overlays/07085-ppedrot-pure-sharing-flag.sh new file mode 100644 index 0000000000..575df07425 --- /dev/null +++ b/dev/ci/user-overlays/07085-ppedrot-pure-sharing-flag.sh @@ -0,0 +1,8 @@ +_OVERLAY_BRANCH=pure-sharing-flag + +if [ "$CI_PULL_REQUEST" = "7085" ] || [ "$CI_BRANCH" = "$_OVERLAY_BRANCH" ]; then + + mtac2_CI_BRANCH="$_OVERLAY_BRANCH" + mtac2_CI_GITURL=https://github.com/ppedrot/Mtac2 + +fi diff --git a/dev/ci/user-overlays/07859-printers.sh b/dev/ci/user-overlays/07859-printers.sh deleted file mode 100644 index 27f588e214..0000000000 --- a/dev/ci/user-overlays/07859-printers.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/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/dev/ci/user-overlays/07908-proj-mind.sh b/dev/ci/user-overlays/07908-proj-mind.sh deleted file mode 100644 index 293eeb5a5a..0000000000 --- a/dev/ci/user-overlays/07908-proj-mind.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/sh - -if [ "$CI_PULL_REQUEST" = "7908" ] || [ "$CI_BRANCH" = "proj-mind" ]; then - Equations_CI_BRANCH=fix-proj-mind - Equations_CI_GITURL=https://github.com/SkySkimmer/Coq-Equations -fi diff --git a/dev/ci/user-overlays/07941-bollu-questionmark-into-record-for-missing-record-field-error.sh b/dev/ci/user-overlays/07941-bollu-questionmark-into-record-for-missing-record-field-error.sh deleted file mode 100644 index 56c0dc3433..0000000000 --- a/dev/ci/user-overlays/07941-bollu-questionmark-into-record-for-missing-record-field-error.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/sh - -if [ "$CI_PULL_REQUEST" = "7941" ] || [ "$CI_BRANCH" = "jun-27-missing-record-field-error-message-quickfix" ]; then - Equations_CI_BRANCH=overlay-question-mark-extended-for-missing-record-field - Equations_CI_GITURL=https://github.com/bollu/Coq-Equations -fi diff --git a/dev/ci/user-overlays/08063-jasongross-string-eqb.sh b/dev/ci/user-overlays/08063-jasongross-string-eqb.sh deleted file mode 100644 index 99a11b9fbf..0000000000 --- a/dev/ci/user-overlays/08063-jasongross-string-eqb.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/sh - -if [ "$CI_PULL_REQUEST" = "8063" ] || [ "$CI_BRANCH" = "string-eqb" ]; then - quickchick_CI_BRANCH=fix-for-pr-8063 - quickchick_CI_GITURL=https://github.com/JasonGross/QuickChick -fi diff --git a/dev/ci/user-overlays/README.md b/dev/ci/user-overlays/README.md index d38d1b06d1..68afe7ee4a 100644 --- a/dev/ci/user-overlays/README.md +++ b/dev/ci/user-overlays/README.md @@ -7,10 +7,12 @@ request to test it with the adapted version of the external project. An overlay is a file which defines where to look for the patched version so that testing is possible. It redefines some variables from [`ci-basic-overlay.sh`](../ci-basic-overlay.sh): -give the name of your branch using a `_CI_BRANCH` variable and the location of -your fork using a `_CI_GITURL` variable. +give the name of your branch / commit using a `_CI_REF` variable and the +location of your fork using a `_CI_GITURL` variable. The `_CI_GITURL` variable should be the URL of the repository without a trailing `.git`. +If the fork is not on the same platform (e.g. GitHub instead of GitLab), it is +necessary to redefine the `_CI_ARCHIVEURL` variable as well. Moreover, the file contains very simple logic to test the pull request number or branch name and apply it only in this case. @@ -25,7 +27,7 @@ Example: `00669-maximedenes-ssr-merge.sh` containing #!/bin/sh if [ "$CI_PULL_REQUEST" = "669" ] || [ "$CI_BRANCH" = "ssr-merge" ]; then - mathcomp_CI_BRANCH=ssr-merge + mathcomp_CI_REF=ssr-merge mathcomp_CI_GITURL=https://github.com/maximedenes/math-comp fi ``` diff --git a/dev/ci/user-overlays/jasongross-numeral-notation-4.sh b/dev/ci/user-overlays/jasongross-numeral-notation-4.sh new file mode 100644 index 0000000000..76aa37d380 --- /dev/null +++ b/dev/ci/user-overlays/jasongross-numeral-notation-4.sh @@ -0,0 +1,5 @@ +if [ "$CI_PULL_REQUEST" = "8064" ] || [ "$CI_BRANCH" = "numeral-notation-4" ]; then + HoTT_CI_REF=fix-for-numeral-notations + HoTT_CI_GITURL=https://github.com/JasonGross/HoTT + HoTT_CI_ARCHIVEURL=${HoTT_CI_GITURL}/archive +fi diff --git a/dev/doc/build-system.dev.txt b/dev/doc/build-system.dev.txt index abba13428f..b0a2b04121 100644 --- a/dev/doc/build-system.dev.txt +++ b/dev/doc/build-system.dev.txt @@ -1,5 +1,3 @@ - - HISTORY: ------- @@ -35,13 +33,41 @@ HISTORY: grammar.cma (and q_constr.cmo) directly, no need for a separate subcall to make nor awkward include-failed-and-retry. - ---------------------------------------------------------------------------- +* February - September 2018 (Emilio Jesús Gallego Arias) + + Dune support added. + + The build setup is mostly vanilla for the OCaml part, however the + `.v` to `.vo` compilation relies on `coq_dune` a `coqdep` wrapper + that will generate the necessary `dune` files. + + As a developer, you should not have to deal with Dune configuration + files on a regular basis unless adding a new library or plugin. + The vanilla setup declares all the Coq libraries and binaries [we + must respect proper containment/module implementation rules as to + allow packing], and we build custom preprocessors (based on `camlp5` + and `coqpp`) that will process the `ml4`/`mlg` files. + + This suffices to build `coqtop` and `coqide`, all that remains to + handle is `.vo` compilation. + + To teach Dune about the `.vo`, we use a small utility `coq_dune`, + that will generate a `dune` file for each directory in `plugins` and + `theories`. The code is pretty straightforward and declares build + and install rules for each `.v` straight out of `coqdep`. Thus, our + build strategy looks like this: + + 1. Use `dune` to build `coqdep` and `coq_dune`. + 2. Use `coq_dune` to generate `dune` files for each directory with `.v` files. + 3. ? + 4. Profit! [Seriously, at this point Dune has all the information to build Coq] + +--------------------------------------------------------------------------- -This file documents internals of the implementation of the build -system. For what a Coq developer needs to know about the build system, -see build-system.txt . +This file documents internals of the implementation of the make-based +build system. For what a Coq developer needs to know about the build +system, see build-system.txt and build-system.dune.md . .ml4 files ---------- diff --git a/dev/doc/build-system.dune.md b/dev/doc/build-system.dune.md new file mode 100644 index 0000000000..0b3e414513 --- /dev/null +++ b/dev/doc/build-system.dune.md @@ -0,0 +1,92 @@ +This file documents what a Coq developer needs to know about the +Dune-based build system. If you want to enhance the build system +itself (or are curious about its implementation details), see +build-system.dev.txt, and in particular its initial HISTORY section. + +Dune +==== + +Coq can now be built using +[Dune](https://github.com/ocaml/dune). Contrary to other systems, +Dune, doesn't use a global`makefile` but local build files named +`dune` that are later composed to form a global build. + +As a developer, Dune should take care of all OCaml-related build tasks +including library management, merlin files, and link order. You are +are not supposed to modify the `dune` files unless you are adding a +new binary, library, or plugin. + +The current Dune setup also doesn't require a call to `configure`. The +auto-generated configuration files are properly included in the +dependency graph so it will be automatically generated by Dune with +reasonable developer defaults. You can still override the defaults by +manually calling `./configure`, but note that some configure options +such as install paths are not used by Dune. + +Dune uses a separate directory `_build` to store build artifacts; it +will generate an `.install` file so artifacts in the build can be +properly installed by package managers. + +## Targets + +The default dune target is `dune build` (or `dune build @install`), +which will scan all sources in the Coq tree and then build the whole +project, creating an "install" overlay in `_build/install/default`. + +You can build some other target by doing `dune build $TARGET`. + +In order to build a single package, you can do `dune build +$PACKAGE.install`. Dune also provides targets for documentation and +testing, see below. + +## Compositionality, developer and release modes. + +By default [in "developer mode"], Dune will compose all the packages +present in the tree and perform a global build. That means that for +example you could drop the `ltac2` folder under `plugins` and get a +build using `ltac2`, that will use the current Coq version. + +This is very useful to develop plugins and Coq libraries as your +plugin will correctly track dependencies and rebuild incrementally as +needed. + +However, it is not always desirable to go this way. For example, the +current Coq source tree contains two packages [Coq and CoqIDE], and in +the OPAM CoqIDE package we don't want to build CoqIDE against the +local copy of Coq. For this purpose, Dune supports the `-p` option, so +`dune build -p coqide` will build CoqIDE against the system-installed +version of Coq libs. + +## Stanzas + +`dune` files contain the so-called "stanzas", that may declare: + +- libraries, +- executables, +- documentation, arbitrary blobs. + +The concrete options for each stanza can be seen in the Dune manual, +but usually the default setup will work well with the current Coq +sources. Note that declaring a library or an executable won't make it +installed by default, for that, you need to provide a "public name". + +## Workspaces and Profiles + +Dune provides support for tree workspaces so the developer can set +global options --- such as flags --- on all packages, or build Coq +with different OPAM switches simultaneously [for example to test +compatibility]; for more information, please refer to the Dune manual. + +## Documentation and test targets + +The documentation and test suite targets for Coq are still not +implemented in Dune. + +## Planned and Advanced features + +Dune supports or will support extra functionality that may result very +useful to Coq, some examples are: + +- Cross-compilation. +- Automatic Generation of OPAM files. +- Multi-directory libraries. diff --git a/doc/README.md b/doc/README.md index 6c6e1f01fb..47507de52d 100644 --- a/doc/README.md +++ b/doc/README.md @@ -9,8 +9,8 @@ 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 -<https://gitlab.com/coq/coq/-/jobs/artifacts/master/file/_install_ci/share/doc/coq/sphinx/html/index.html?job=documentation>. +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=doc:refman>. The reference manual is written is reStructuredText and compiled using Sphinx. See [`sphinx/README.rst`](sphinx/README.rst) @@ -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 2264b170fc..4673107e3d 100644 --- a/doc/sphinx/README.rst +++ b/doc/sphinx/README.rst @@ -32,7 +32,7 @@ Names (link targets) are auto-generated for most simple objects, though they can - Vernacs (commands) have their name set to the first word of their signature. For example, the auto-generated name of ``Axiom @ident : @term`` is ``Axiom``, and a link to it would take the form ``:cmd:`Axiom```. - Vernac variants, tactic notations, and tactic variants do not have a default name. -Most objects should have a body (i.e. a block of indented text following the signature, called “contents” in Sphinx terms). Undocumented objects should have the `:undocumented:` flag instead, as shown above. When multiple objects have a single description, they can be grouped into a single object, like this (semicolons can be used to separate the names of the objects):: +Most objects should have a body (i.e. a block of indented text following the signature, called “contents” in Sphinx terms). Undocumented objects should have the `:undocumented:` flag instead, as shown above. When multiple objects have a single description, they can be grouped into a single object, like this (semicolons can be used to separate the names of the objects; names starting with ``_`` will be omitted from the indexes):: .. cmdv:: Lemma @ident {? @binders} : @type Remark @ident {? @binders} : @type diff --git a/doc/sphinx/README.template.rst b/doc/sphinx/README.template.rst index f1d2541eb6..c333d6e9d5 100644 --- a/doc/sphinx/README.template.rst +++ b/doc/sphinx/README.template.rst @@ -32,7 +32,7 @@ Names (link targets) are auto-generated for most simple objects, though they can - Vernacs (commands) have their name set to the first word of their signature. For example, the auto-generated name of ``Axiom @ident : @term`` is ``Axiom``, and a link to it would take the form ``:cmd:`Axiom```. - Vernac variants, tactic notations, and tactic variants do not have a default name. -Most objects should have a body (i.e. a block of indented text following the signature, called “contents” in Sphinx terms). Undocumented objects should have the `:undocumented:` flag instead, as shown above. When multiple objects have a single description, they can be grouped into a single object, like this (semicolons can be used to separate the names of the objects):: +Most objects should have a body (i.e. a block of indented text following the signature, called “contents” in Sphinx terms). Undocumented objects should have the `:undocumented:` flag instead, as shown above. When multiple objects have a single description, they can be grouped into a single object, like this (semicolons can be used to separate the names of the objects; names starting with ``_`` will be omitted from the indexes):: .. cmdv:: Lemma @ident {? @binders} : @type Remark @ident {? @binders} : @type diff --git a/doc/sphinx/addendum/canonical-structures.rst b/doc/sphinx/addendum/canonical-structures.rst index 3af3115a59..2cc1f95c08 100644 --- a/doc/sphinx/addendum/canonical-structures.rst +++ b/doc/sphinx/addendum/canonical-structures.rst @@ -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 diff --git a/doc/sphinx/addendum/extraction.rst b/doc/sphinx/addendum/extraction.rst index 8c1eacf085..e3d25cf5cf 100644 --- a/doc/sphinx/addendum/extraction.rst +++ b/doc/sphinx/addendum/extraction.rst @@ -423,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 @@ -458,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 @@ -469,7 +469,7 @@ 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 ------------- diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst index c7df250672..e0babb6c4e 100644 --- a/doc/sphinx/addendum/generalized-rewriting.rst +++ b/doc/sphinx/addendum/generalized-rewriting.rst @@ -22,18 +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 into two parts: generation of the rewriting constraints (written in ML) and solving - these constraints using type class resolution. As type class + these constraints using typeclass resolution. As typeclass resolution is extensible using tactics, this allows users to define general ways to solve morphism constraints. + 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. @@ -226,7 +226,7 @@ following command. 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 type class instance definition and as the name of + 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 @@ -309,7 +309,7 @@ following command. Proof. intros. rewrite empty_neutral. reflexivity. Qed. - The tables of relations and morphisms are managed by the type class + 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 @@ -350,7 +350,7 @@ prove that the argument of the morphism is defined. .. example:: Let ``eqO`` be ``fun x y => x = y /\ x <> 0`` (the - smallest PER over non zero elements). Division can be declared as a + 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``. @@ -446,7 +446,7 @@ 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: @@ -472,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 @@ -703,7 +703,7 @@ 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 f134022eb6..c0c4539564 100644 --- a/doc/sphinx/addendum/implicit-coercions.rst +++ b/doc/sphinx/addendum/implicit-coercions.rst @@ -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. diff --git a/doc/sphinx/addendum/omega.rst b/doc/sphinx/addendum/omega.rst index 1ed3bffd2c..1e92d01125 100644 --- a/doc/sphinx/addendum/omega.rst +++ b/doc/sphinx/addendum/omega.rst @@ -11,7 +11,7 @@ Description of ``omega`` .. tacn:: omega :tacn:`omega` is a tactic for solving goals in Presburger arithmetic, - i.e. for proving formulas made of equations and inequations over the + 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. @@ -140,12 +140,12 @@ Technical data Overview of the tactic ~~~~~~~~~~~~~~~~~~~~~~ - * The goal is negated twice and the first negation is introduced as an hypothesis. - * Hypotheses 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 + * Equations and inequalities over ``nat`` are translated over ``Z``, multiple goals may result from the translation of subtraction. - * Equations and inequations are normalized. + * Equations and inequalities are normalized. * Goals are solved by the OMEGA decision procedure. * The script of the solution is replayed. @@ -156,17 +156,17 @@ 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, 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 cuts the Euclidean space in half. - * Inequations are solved by projecting on the hyperspace + * 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). diff --git a/doc/sphinx/addendum/program.rst b/doc/sphinx/addendum/program.rst index 28fe68d78d..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 @@ -72,8 +72,8 @@ operation (see :ref:`extendedpatternmatching`). 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 :g:`∀ p, _ <> S (S p)`. + Coercion. If the object being matched is coercible to an inductive @@ -87,7 +87,7 @@ 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 + 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,7 +104,7 @@ 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 @@ -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: diff --git a/doc/sphinx/addendum/ring.rst b/doc/sphinx/addendum/ring.rst index d5c33dc1d4..8cb86e2267 100644 --- a/doc/sphinx/addendum/ring.rst +++ b/doc/sphinx/addendum/ring.rst @@ -19,7 +19,7 @@ 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 @@ -37,7 +37,7 @@ 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 the ``ring`` tactic do? It normalizes polynomials over -any ring or semi-ring structure. The basic use of ``ring`` is to simplify ring +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. @@ -103,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 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. @@ -264,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 @@ -505,10 +505,10 @@ 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 @@ -616,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 @@ -670,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``, @@ -684,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 @@ -707,7 +707,7 @@ interleaving of computation and reasoning (see :ref:`discussion_reflection`). He 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. diff --git a/doc/sphinx/addendum/type-classes.rst b/doc/sphinx/addendum/type-classes.rst index b7946c6451..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`. @@ -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: @@ -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 command adds an arbitrary list of constants whose type ends with - an applied type class to the instance database with an optional + 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,13 +379,13 @@ 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 typeclass goals like any other. @@ -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} @@ -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 f245fab5ca..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}`. 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 a63400103f..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: @@ -781,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 := @@ -1252,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` @@ -1398,7 +1399,7 @@ 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. @@ -1821,7 +1822,7 @@ 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, @@ -1832,7 +1833,7 @@ command, the following is rejected, 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/gallina-extensions.rst b/doc/sphinx/language/gallina-extensions.rst index 7dd0a6e383..0fbe7ac70b 100644 --- a/doc/sphinx/language/gallina-extensions.rst +++ b/doc/sphinx/language/gallina-extensions.rst @@ -212,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: @@ -229,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. @@ -328,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: @@ -711,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. @@ -1260,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`). @@ -1294,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** @@ -1328,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: @@ -1514,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 @@ -1887,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 ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1937,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 da5cd00d72..075235a8e2 100644 --- a/doc/sphinx/language/gallina-specification-language.rst +++ b/doc/sphinx/language/gallina-specification-language.rst @@ -920,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 @@ -1124,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 diff --git a/doc/sphinx/practical-tools/coq-commands.rst b/doc/sphinx/practical-tools/coq-commands.rst index 88da58c27d..9498f37c7e 100644 --- a/doc/sphinx/practical-tools/coq-commands.rst +++ b/doc/sphinx/practical-tools/coq-commands.rst @@ -90,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``. @@ -104,8 +104,12 @@ 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 logical directory *dirpath*. The subdirectory structure of *directory* is @@ -115,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. @@ -168,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, @@ -208,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 @@ -248,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, -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 f7f442092f..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. @@ -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 diff --git a/doc/sphinx/practical-tools/utilities.rst b/doc/sphinx/practical-tools/utilities.rst index e779515a00..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. @@ -773,7 +773,7 @@ Command line options 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 be processed from the 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. diff --git a/doc/sphinx/proof-engine/detailed-tactic-examples.rst b/doc/sphinx/proof-engine/detailed-tactic-examples.rst index 225df8d54c..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: @@ -473,9 +473,8 @@ corresponding left-hand side and call yourself recursively on sub- terms. If there is no match, we are at a leaf: return the corresponding constructor (here ``f_const``) applied to the term. -.. exn:: quote: not a simple fixpoint - - Happens when ``quote`` is not able to perform inversion properly. +When ``quote`` is not able to perform inversion properly, it will error out with +:exn:`quote: not a simple fixpoint`. Introducing variables map diff --git a/doc/sphinx/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst index 0310dbead5..7608ea7245 100644 --- a/doc/sphinx/proof-engine/ltac.rst +++ b/doc/sphinx/proof-engine/ltac.rst @@ -556,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. @@ -863,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 @@ -989,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 b49d0f0504..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 @@ -369,7 +372,7 @@ Navigation in the proof tree Brackets are used to focus on a single goal given either by its position or by its name if it has one. - .. seealso:: The error messages about bullets below. + .. seealso:: The error messages about bullets below. .. _bullets: diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst index 8a2fc3996a..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 - - 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 @@ -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 - - 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 @@ -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: + + .. coqtop:: in - Definition foo x := nosimpl bar x. + Definition foo x := nosimpl bar x. A standard example making this technique shine is the case of arithmetic operations. We define for instance: @@ -4794,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:: @@ -4907,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 fdb04bf9a0..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,35 +175,39 @@ 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. @@ -215,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. @@ -252,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`. + 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 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. + 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}. @@ -302,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 @@ -311,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 @@ -327,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 @@ -349,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`. @@ -365,6 +368,7 @@ 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:: @@ -455,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 + .. exn:: Not an inductive product. + :undocumented: - 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 enough constructors. + :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). + .. tacv:: constructor -.. tacv:: split - :name: split + 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. - 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`. + .. tacv:: constructor @num with @bindings_list -.. exn:: Not an inductive goal with 1 constructor + 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`. -.. tacv:: exists @val - :name: exists - - 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: @@ -623,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 + + 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`. -.. tacv:: intro @ident after @ident -.. tacv:: intro @ident before @ident -.. tacv:: intro @ident at top -.. tacv:: intro @ident at bottom + .. note:: - 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 ...`). + :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 ... @@ -766,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 @@ -792,60 +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:: + .. example:: - .. coqtop:: all + .. coqtop:: reset all - Goal forall A B C:Prop, A \/ B /\ C -> (A -> C) -> C. - intros * [a | (_,c)] f. + 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 @@ -854,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` @@ -872,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 @@ -912,172 +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:: + .. exn:: Cannot move @ident__1 after @ident__2: it occurs in the type of @ident__2. + :undocumented: - .. coqtop:: all + .. 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__1 {? eqn:@ident__2 } in @goal_occurrences -.. tacv:: remember @term as @ident in @goal_occurrences + This is a more general form of :tacn:`remember` that remembers the + occurrences of :token:`term` specified by an occurrence set. - This is a more general form of :n:`remember` that remembers the occurrences - of term specified by an occurrence set. + .. tacv:: eremember @term as @ident__1 {? eqn:@ident__2 } {? in @goal_occurrences } + :name: eremember -.. tacv:: eremember @term as @ident -.. tacv:: eremember @term as @ident in @goal_occurrences -.. tacv:: eremember @term as @ident eqn:@ident - :name: eremember + While the different variants of :tacn:`remember` expect that no + existential variables are generated by the tactic, :tacn:`eremember` + removes this constraint. - While the different variants of :n:`remember` expect that no existential - variables are generated by the tactic, :n:`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 @@ -1085,25 +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:: + .. example:: - .. coqtop:: all + .. 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; assumption. - Qed. + 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 or). + This decomposes sum types (like :g:`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: @@ -1368,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. @@ -1410,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 @@ -1563,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)`). @@ -1855,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. @@ -2018,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 @@ -2289,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 @@ -3182,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 @@ -3213,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} @@ -3270,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 @@ -3569,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. @@ -3579,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. @@ -3708,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} @@ -4182,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 @@ -4290,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. @@ -4343,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 ------------------------ @@ -4465,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/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst index d92b9a6794..b46382dbbf 100644 --- a/doc/sphinx/user-extensions/syntax-extensions.rst +++ b/doc/sphinx/user-extensions/syntax-extensions.rst @@ -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,7 +139,7 @@ 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 during typechecking. +expected to be inferred during type checking. .. coqtop:: in @@ -296,7 +296,7 @@ the possible following elements delimited by single quotes: after the “``[``” is applied at the beginning of each newline Notations disappear when a section is closed. No typing of the denoted -expression is performed at definition time. Type-checking is done only +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 @@ -899,7 +899,7 @@ notations are given below. The optional :production:`scope` is described in : | 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:: Some examples of Notation may be found in the files composing the initial state of Coq (see directory :file:`$COQLIB/theories/Init`). @@ -1369,9 +1369,157 @@ Abbreviations Check (id 0). Abbreviations disappear when a section is closed. No typing of the - denoted expression is performed at definition time. Type-checking is + denoted expression is performed at definition time. Type checking is done only at the time of use of the abbreviation. + +Numeral notations +----------------- + +.. cmd:: Numeral Notation @ident__1 @ident__2 @ident__3 : @scope. + + This command allows the user to customize the way numeral literals + are parsed and printed. + + The token :n:`@ident__1` should be the name of an inductive type, + while :n:`@ident__2` and :n:`@ident__3` should be the names of the + parsing and printing functions, respectively. The parsing function + :n:`@ident__2` should have one of the following types: + + * :n:`Decimal.int -> @ident__1` + * :n:`Decimal.int -> option @ident__1` + * :n:`Decimal.uint -> @ident__1` + * :n:`Decimal.uint -> option @ident__1` + * :n:`Z -> @ident__1` + * :n:`Z -> option @ident__1` + + And the printing function :n:`@ident__3` should have one of the + following types: + + * :n:`@ident__1 -> Decimal.int` + * :n:`@ident__1 -> option Decimal.int` + * :n:`@ident__1 -> Decimal.uint` + * :n:`@ident__1 -> option Decimal.uint` + * :n:`@ident__1 -> Z` + * :n:`@ident__1 -> option Z` + + When parsing, the application of the parsing function + :n:`@ident__2` to the number will be fully reduced, and universes + of the resulting term will be refreshed. + + .. cmdv:: Numeral Notation @ident__1 @ident__2 @ident__3 : @scope (warning after @num). + + When a literal larger than :token:`num` is parsed, a warning + message about possible stack overflow, resulting from evaluating + :n:`@ident__2`, will be displayed. + + .. cmdv:: Numeral Notation @ident__1 @ident__2 @ident__3 : @scope (abstract after @num). + + When a literal :g:`m` larger than :token:`num` is parsed, the + result will be :n:`(@ident__2 m)`, without reduction of this + application to a normal form. Here :g:`m` will be a + :g:`Decimal.int` or :g:`Decimal.uint` or :g:`Z`, depending on the + type of the parsing function :n:`@ident__2`. This allows for a + more compact representation of literals in types such as :g:`nat`, + and limits parse failures due to stack overflow. Note that a + warning will be emitted when an integer larger than :token:`num` + is parsed. Note that :n:`(abstract after @num)` has no effect + when :n:`@ident__2` lands in an :g:`option` type. + + .. exn:: Cannot interpret this number as a value of type @type + + The numeral notation registered for :token:`type` does not support + the given numeral. This error is given when the interpretation + function returns :g:`None`, or if the interpretation is registered + for only non-negative integers, and the given numeral is negative. + + .. exn:: @ident should go from Decimal.int to @type or (option @type). Instead of Decimal.int, the types Decimal.uint or Z could be used{? (require BinNums first)}. + + The parsing function given to the :cmd:`Numeral Notation` + vernacular is not of the right type. + + .. exn:: @ident should go from @type to Decimal.int or (option Decimal.int). Instead of Decimal.int, the types Decimal.uint or Z could be used{? (require BinNums first)}. + + The printing function given to the :cmd:`Numeral Notation` + vernacular is not of the right type. + + .. exn:: @type is not an inductive type. + + Numeral notations can only be declared for inductive types with no + arguments. + + .. exn:: Unexpected term @term while parsing a numeral notation. + + Parsing functions must always return ground terms, made up of + applications of constructors and inductive types. Parsing + functions may not return terms containing axioms, bare + (co)fixpoints, lambdas, etc. + + .. exn:: Unexpected non-option term @term while parsing a numeral notation. + + Parsing functions expected to return an :g:`option` must always + return a concrete :g:`Some` or :g:`None` when applied to a + concrete numeral expressed as a decimal. They may not return + opaque constants. + + .. exn:: Cannot interpret in @scope because @ident could not be found in the current environment. + + The inductive type used to register the numeral notation is no + longer available in the environment. Most likely, this is because + the numeral notation was declared inside a functor for an + inductive type inside the functor. This use case is not currently + supported. + + Alternatively, you might be trying to use a primitive token + notation from a plugin which forgot to specify which module you + must :g:`Require` for access to that notation. + + .. exn:: Syntax error: [prim:reference] expected after 'Notation' (in [vernac:command]). + + The type passed to :cmd:`Numeral Notation` must be a single + identifier. + + .. exn:: Syntax error: [prim:reference] expected after [prim:reference] (in [vernac:command]). + + Both functions passed to :cmd:`Numeral Notation` must be single + identifiers. + + .. exn:: The reference @ident was not found in the current environment. + + Identifiers passed to :cmd:`Numeral Notation` must exist in the + global environment. + + .. exn:: @ident is bound to a notation that does not denote a reference. + + Identifiers passed to :cmd:`Numeral Notation` must be global + references, or notations which denote to single identifiers. + + .. warn:: Stack overflow or segmentation fault happens when working with large numbers in @type (threshold may vary depending on your system limits and on the command executed). + + When a :cmd:`Numeral Notation` is registered in the current scope + with :n:`(warning after @num)`, this warning is emitted when + parsing a numeral greater than or equal to :token:`num`. + + .. warn:: To avoid stack overflow, large numbers in @type are interpreted as applications of @ident__2. + + When a :cmd:`Numeral Notation` is registered in the current scope + with :n:`(abstract after @num)`, this warning is emitted when + parsing a numeral greater than or equal to :token:`num`. + Typically, this indicates that the fully computed representation + of numerals can be so large that non-tail-recursive OCaml + functions run out of stack space when trying to walk them. + + For example + + .. coqtop:: all + + Check 90000. + + .. warn:: The 'abstract after' directive has no effect when the parsing function (@ident__2) targets an option type. + + As noted above, the :n:`(abstract after @num)` directive has no + effect when :n:`@ident__2` lands in an :g:`option` type. + .. _TacticNotation: Tactic Notations @@ -1431,7 +1579,7 @@ Tactic notations allow to customize the syntax of tactics. They have the followi * - ``hyp`` - identifier - - an hypothesis defined in context + - a hypothesis defined in context - clear * - ``reference`` @@ -1503,7 +1651,7 @@ Tactic notations allow to customize the syntax of tactics. They have the followi .. [#and_or_levels] which are the levels effectively chosen in the current implementation of Coq -.. [#no_associativity] Coq accepts notations declared as non-associative but the parser on +.. [#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/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template index f448248468..0fa42cadad 100644 --- a/doc/stdlib/index-list.html.template +++ b/doc/stdlib/index-list.html.template @@ -226,6 +226,7 @@ through the <tt>Require Import</tt> command.</p> theories/Numbers/BinNums.v theories/Numbers/NumPrelude.v theories/Numbers/NaryFunctions.v + theories/Numbers/AltBinNotations.v theories/Numbers/DecimalFacts.v theories/Numbers/DecimalNat.v theories/Numbers/DecimalPos.v diff --git a/doc/tools/coqrst/coqdomain.py b/doc/tools/coqrst/coqdomain.py index a0dc16aac7..40554c3ca3 100644 --- a/doc/tools/coqrst/coqdomain.py +++ b/doc/tools/coqrst/coqdomain.py @@ -123,7 +123,13 @@ class CoqObject(ObjectDescription): """ self._render_annotation(signode) self._render_signature(signature, signode) - return self._names.get(signature) or self._name_from_signature(signature) + name = self._names.get(signature) + if name is None: + name = self._name_from_signature(signature) + # remove trailing ‘.’ found in commands, but not ‘...’ (ellipsis) + if name is not None and name.endswith(".") and not name.endswith("..."): + name = name[:-1] + return name def _warn_if_duplicate_name(self, objects, name): """Check that two objects in the same domain don't have the same name.""" @@ -157,18 +163,17 @@ class CoqObject(ObjectDescription): def _add_index_entry(self, name, target): """Add `name` (pointing to `target`) to the main index.""" - index_text = name - if self.index_suffix: - index_text += " " + self.index_suffix - self.indexnode['entries'].append(('single', index_text, target, '', None)) + assert isinstance(name, str) + if not name.startswith("_"): + index_text = name + if self.index_suffix: + index_text += " " + self.index_suffix + self.indexnode['entries'].append(('single', index_text, target, '', None)) def add_target_and_index(self, name, _, signode): """Attach a link target to `signode` and an index entry for `name`.""" if name: target = self._add_target(signode, name) - # remove trailing . , found in commands, but not ... (ellipsis) - if name[-1] == "." and not name[-3:] == "..." : - name = name[0:-1] self._add_index_entry(name, target) return target @@ -0,0 +1,15 @@ +(rule + (targets .vfiles.d) + (deps + (source_tree theories) + (source_tree plugins)) + (action (with-stdout-to .vfiles.d (system "%{bin:coqdep} -dyndep opt -noglob -boot `find theories plugins -type f -name *.v`")))) + +(alias + (name vodeps) + (deps tools/coq_dune.exe .vfiles.d)) + ; (action (run coq_dune .vfiles.d)))) + +; Add custom flags here. Default developer profile is `dev` +(env + (dev (flags :standard -rectypes -w -9-27-50))) diff --git a/dune-project b/dune-project new file mode 100644 index 0000000000..b98bfa1013 --- /dev/null +++ b/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.0) + +(name coq-devel) diff --git a/engine/dune b/engine/dune new file mode 100644 index 0000000000..e2b7ab9c87 --- /dev/null +++ b/engine/dune @@ -0,0 +1,6 @@ +(library + (name engine) + (synopsis "Coq's Tactic Engine") + (public_name coq.engine) + (wrapped false) + (libraries library)) diff --git a/engine/evd.ml b/engine/evd.ml index d1c7fef738..9f976b57dd 100644 --- a/engine/evd.ml +++ b/engine/evd.ml @@ -774,7 +774,7 @@ let universe_subst evd = UState.subst evd.universes let merge_context_set ?loc ?(sideff=false) rigid evd ctx' = - {evd with universes = UState.merge ?loc sideff rigid evd.universes ctx'} + {evd with universes = UState.merge ?loc ~sideff ~extend:true rigid evd.universes ctx'} let merge_universe_subst evd subst = {evd with universes = UState.merge_subst evd.universes subst } diff --git a/engine/proofview.mli b/engine/proofview.mli index 970bf67732..a9666e4f90 100644 --- a/engine/proofview.mli +++ b/engine/proofview.mli @@ -532,7 +532,7 @@ module Goal : sig (** Compatibility: avoid if possible *) val goal : t -> Evar.t - val print : t -> Goal.goal Evd.sigma + val print : t -> Evar.t Evd.sigma end diff --git a/engine/uState.ml b/engine/uState.ml index 0791e4c277..29cb3c9bcc 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -430,10 +430,17 @@ let univ_rigid = UnivRigid let univ_flexible = UnivFlexible false let univ_flexible_alg = UnivFlexible true -let merge ?loc sideff rigid uctx ctx' = +(** ~sideff indicates that it is ok to redeclare a universe. + ~extend also merges the universe context in the local constraint structures + and not only in the graph. This depends if the + context we merge comes from a side effect that is already inlined + or defined separately. In the later case, there is no extension, + see [emit_side_effects] for example. *) +let merge ?loc ~sideff ~extend rigid uctx ctx' = let open Univ in let levels = ContextSet.levels ctx' in - let uctx = if sideff then uctx else + let uctx = + if not extend then uctx else match rigid with | UnivRigid -> uctx | UnivFlexible b -> @@ -448,9 +455,8 @@ let merge ?loc sideff rigid uctx ctx' = else { uctx with uctx_univ_variables = uvars' } in let uctx_local = - if sideff then uctx.uctx_local - else ContextSet.append ctx' uctx.uctx_local - in + if not extend then uctx.uctx_local + else ContextSet.append ctx' uctx.uctx_local in let declare g = LSet.fold (fun u g -> try UGraph.add_universe u false g @@ -479,7 +485,7 @@ let merge_subst uctx s = let emit_side_effects eff u = let uctxs = Safe_typing.universes_of_private eff in - List.fold_left (merge true univ_rigid) u uctxs + List.fold_left (merge ~sideff:true ~extend:false univ_rigid) u uctxs let new_univ_variable ?loc rigid name ({ uctx_local = ctx; uctx_univ_variables = uvars; uctx_univ_algebraic = avars} as uctx) = @@ -668,7 +674,7 @@ let update_sigma_env uctx env = { uctx with uctx_initial_universes = univs; uctx_universes = univs } in - merge true univ_rigid eunivs eunivs.uctx_local + merge ~sideff:true ~extend:false univ_rigid eunivs eunivs.uctx_local let pr_weak prl {uctx_weak_constraints=weak} = let open Pp in diff --git a/engine/uState.mli b/engine/uState.mli index a59e61b894..f833508ebf 100644 --- a/engine/uState.mli +++ b/engine/uState.mli @@ -103,7 +103,7 @@ val univ_rigid : rigid val univ_flexible : rigid val univ_flexible_alg : rigid -val merge : ?loc:Loc.t -> bool -> rigid -> t -> Univ.ContextSet.t -> t +val merge : ?loc:Loc.t -> sideff:bool -> extend:bool -> rigid -> t -> Univ.ContextSet.t -> t val merge_subst : t -> UnivSubst.universe_opt_subst -> t val emit_side_effects : Safe_typing.private_constants -> t -> t diff --git a/grammar/dune b/grammar/dune new file mode 100644 index 0000000000..90847e7fb6 --- /dev/null +++ b/grammar/dune @@ -0,0 +1,41 @@ +(library + (name grammar) + (synopsis "Coq Camlp5 Grammar Extensions for Plugins") + (public_name coq.grammar) + (wrapped false) + (flags (:standard -w -58)) + (libraries camlp5)) + +; Custom camlp5! This is a net speedup, and a preparation for using +; Dune's preprocessor abilities. +(rule + (targets coqmlp5) + (action (run mkcamlp5.opt pa_o.cmx pa_op.cmx pr_dump.cmx pa_extend.cmx q_MLast.cmx pa_macro.cmx pr_o.cmx -o coqmlp5))) + +(rule + (targets coqp5) + (action (run mkcamlp5.opt pa_o.cmx pa_op.cmx pr_dump.cmx pa_extend.cmx q_MLast.cmx pa_macro.cmx pr_o.cmx %{dep:grammar.cmxa} -o coqp5))) + +(install + (section bin) + (files coqp5 coqmlp5)) + +(rule + (targets q_util.ml) + (deps (:mlp-file q_util.mlp)) + (action (run coqmlp5 -loc loc -impl %{mlp-file} -o %{targets}))) + +(rule + (targets argextend.ml) + (deps (:mlp-file argextend.mlp)) + (action (run coqmlp5 -loc loc -impl %{mlp-file} -o %{targets}))) + +(rule + (targets tacextend.ml) + (deps (:mlp-file tacextend.mlp)) + (action (run coqmlp5 -loc loc -impl %{mlp-file} -o %{targets}))) + +(rule + (targets vernacextend.ml) + (deps (:mlp-file vernacextend.mlp)) + (action (run coqmlp5 -loc loc -impl %{mlp-file} -o %{targets}))) diff --git a/ide/coqide.opam b/ide/coqide.opam new file mode 100644 index 0000000000..1b46efdee2 --- /dev/null +++ b/ide/coqide.opam @@ -0,0 +1,19 @@ +opam-version: "1.2" +maintainer: "The Coq development team <coqdev@inria.fr>" +authors: "The Coq development team, INRIA, CNRS, and contributors." +homepage: "https://coq.inria.fr/" +bug-reports: "https://github.com/coq/coq/issues" +dev-repo: "https://github.com/coq/coq.git" +license: "LGPL-2.1" + +available: [ocaml-version >= "4.02.3"] + +depends: [ + "dune" { build } + "ocamlfind" { build } + "num" + "camlp5" + "coq" +] + +build: [ [ "dune" "build" "-p" package "-j" jobs ] ] diff --git a/ide/dune b/ide/dune new file mode 100644 index 0000000000..bceb981ed0 --- /dev/null +++ b/ide/dune @@ -0,0 +1,21 @@ +(executable + (name idetop) + (public_name coqidetop.opt) + (package coqide) + (modules idetop) + (libraries coq.toplevel coqide.protocol) + (link_flags -linkall)) + +(rule + (targets coqide_main.ml) + (deps (:ml4-file coqide_main.ml4)) + (action (run coqmlp5 -loc loc -impl %{ml4-file} -o %{targets}))) + +(executable + (name coqide_main) + (public_name coqide) + (package coqide) + (modules (:standard \ idetop)) + (libraries threads str lablgtk2.sourceview2 coq.lib coqide.protocol)) + +(ocamllex utf8_convert config_lexer coq_lex) diff --git a/ide/dune-project b/ide/dune-project new file mode 100644 index 0000000000..948dc59000 --- /dev/null +++ b/ide/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.0) + +(name coqide-devel) diff --git a/ide/protocol/dune b/ide/protocol/dune new file mode 100644 index 0000000000..9ce4559940 --- /dev/null +++ b/ide/protocol/dune @@ -0,0 +1,7 @@ +(library + (name protocol) + (public_name coqide.protocol) + (wrapped false) + (libraries coq.lib)) + +(ocamllex xml_lexer) diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 009894fddb..ddc0a5c000 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -531,18 +531,7 @@ let extern_ind_pattern_in_scope (custom,scopes as allscopes) vars 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_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 allscopes 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 diff --git a/interp/declare.ml b/interp/declare.ml index 2b2ca36edc..a82e6b35a6 100644 --- a/interp/declare.ml +++ b/interp/declare.ml @@ -150,8 +150,8 @@ let register_side_effect (c, role) = ignore(add_leaf id o); update_tables c; match role with - | Safe_typing.Subproof -> () - | Safe_typing.Schema (ind, kind) -> !declare_scheme kind [|ind,c|] + | Subproof -> () + | Schema (ind, kind) -> !declare_scheme kind [|ind,c|] let declare_constant_common id cst = let o = inConstant cst in diff --git a/interp/dune b/interp/dune new file mode 100644 index 0000000000..e9ef7ba99a --- /dev/null +++ b/interp/dune @@ -0,0 +1,6 @@ +(library + (name interp) + (synopsis "Coq's Syntactic Interpretation for AST [notations, implicits]") + (public_name coq.interp) + (wrapped false) + (libraries pretyping)) diff --git a/interp/notation.ml b/interp/notation.ml index 625d072b9f..55ead946cb 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -266,16 +266,14 @@ let keymap_find key map = (* Scopes table : interpretation -> scope_name *) let notations_key_table = ref (KeyMap.empty : notation_rule list KeyMap.t) -let prim_token_key_table = ref (KeyMap.empty : (string * (any_glob_constr -> prim_token option) * bool) KeyMap.t) - let glob_prim_constr_key c = match DAst.get c with - | GRef (ref, _) -> RefKey (canonical_gr ref) + | GRef (ref, _) -> Some (canonical_gr ref) | GApp (c, _) -> begin match DAst.get c with - | GRef (ref, _) -> RefKey (canonical_gr ref) - | _ -> Oth + | GRef (ref, _) -> Some (canonical_gr ref) + | _ -> None end - | _ -> Oth + | _ -> None let glob_constr_keys c = match DAst.get c with | GApp (c, _) -> @@ -303,77 +301,189 @@ let notation_constr_key = function (* Rem: NApp(NRef ref,[]) stands for @ref *) (* Interpreting numbers (not in summary because functional objects) *) type required_module = full_path * string list +type rawnum = Constrexpr.raw_natural_number * Constrexpr.sign -type 'a prim_token_interpreter = - ?loc:Loc.t -> 'a -> glob_constr +type prim_token_uid = string -type cases_pattern_status = bool (* true = use prim token in patterns *) +type 'a prim_token_interpreter = ?loc:Loc.t -> 'a -> glob_constr +type 'a prim_token_uninterpreter = any_glob_constr -> 'a option -type 'a prim_token_uninterpreter = - glob_constr list * (any_glob_constr -> 'a option) * cases_pattern_status +type 'a prim_token_interpretation = + 'a prim_token_interpreter * 'a prim_token_uninterpreter -type internal_prim_token_interpreter = - ?loc:Loc.t -> prim_token -> required_module * (unit -> glob_constr) +module InnerPrimToken = struct -let prim_token_interpreter_tab = - (Hashtbl.create 7 : (scope_name, internal_prim_token_interpreter) Hashtbl.t) + type interpreter = + | RawNumInterp of (?loc:Loc.t -> rawnum -> glob_constr) + | BigNumInterp of (?loc:Loc.t -> Bigint.bigint -> glob_constr) + | StringInterp of (?loc:Loc.t -> string -> glob_constr) -let add_prim_token_interpreter sc interp = - try - let cont = Hashtbl.find prim_token_interpreter_tab sc in - Hashtbl.replace prim_token_interpreter_tab sc (interp cont) - with Not_found -> - let cont = (fun ?loc _p -> raise Not_found) in - Hashtbl.add prim_token_interpreter_tab sc (interp cont) + let interp_eq f f' = match f,f' with + | RawNumInterp f, RawNumInterp f' -> f == f' + | BigNumInterp f, BigNumInterp f' -> f == f' + | StringInterp f, StringInterp f' -> f == f' + | _ -> false -let declare_prim_token_interpreter sc interp (patl,uninterp,b) = - declare_scope sc; - add_prim_token_interpreter sc interp; - List.iter (fun pat -> - prim_token_key_table := KeyMap.add - (glob_prim_constr_key pat) (sc,uninterp,b) !prim_token_key_table) - patl + let ofNumeral n s = + if s then Bigint.of_string n else Bigint.neg (Bigint.of_string n) -let mkNumeral n = - if Bigint.is_pos_or_zero n then Numeral (Bigint.to_string n, true) - else Numeral (Bigint.to_string (Bigint.neg n), false) + let do_interp ?loc interp primtok = + match primtok, interp with + | Numeral (n,s), RawNumInterp interp -> interp ?loc (n,s) + | Numeral (n,s), BigNumInterp interp -> interp ?loc (ofNumeral n s) + | String s, StringInterp interp -> interp ?loc s + | _ -> raise Not_found -let ofNumeral n s = - if s then Bigint.of_string n else Bigint.neg (Bigint.of_string n) + type uninterpreter = + | RawNumUninterp of (any_glob_constr -> rawnum option) + | BigNumUninterp of (any_glob_constr -> Bigint.bigint option) + | StringUninterp of (any_glob_constr -> string option) -let mkString = function -| None -> None -| Some s -> if Unicode.is_utf8 s then Some (String s) else None + let uninterp_eq f f' = match f,f' with + | RawNumUninterp f, RawNumUninterp f' -> f == f' + | BigNumUninterp f, BigNumUninterp f' -> f == f' + | StringUninterp f, StringUninterp f' -> f == f' + | _ -> false -let delay dir int ?loc x = (dir, (fun () -> int ?loc x)) + let mkNumeral n = + if Bigint.is_pos_or_zero n then Numeral (Bigint.to_string n, true) + else Numeral (Bigint.to_string (Bigint.neg n), false) -type rawnum = Constrexpr.raw_natural_number * Constrexpr.sign + let mkString = function + | None -> None + | Some s -> if Unicode.is_utf8 s then Some (String s) else None + + let do_uninterp uninterp g = match uninterp with + | RawNumUninterp u -> Option.map (fun (n,s) -> Numeral (n,s)) (u g) + | BigNumUninterp u -> Option.map mkNumeral (u g) + | StringUninterp u -> mkString (u g) + +end + +(* The following two tables of (un)interpreters will *not* be synchronized. + But their indexes will be checked to be unique *) +let prim_token_interpreters = + (Hashtbl.create 7 : (prim_token_uid, InnerPrimToken.interpreter) Hashtbl.t) + +let prim_token_uninterpreters = + (Hashtbl.create 7 : (prim_token_uid, InnerPrimToken.uninterpreter) Hashtbl.t) + +(* Table from scope_name to backtrack-able informations about interpreters + (in particular interpreter unique id). *) +let prim_token_interp_infos = + ref (String.Map.empty : (required_module * prim_token_uid) String.Map.t) + +(* Table from global_reference to backtrack-able informations about + prim_token uninterpretation (in particular uninterpreter unique id). *) +let prim_token_uninterp_infos = + ref (Refmap.empty : (scope_name * prim_token_uid * bool) Refmap.t) + +let hashtbl_check_and_set allow_overwrite uid f h eq = + match Hashtbl.find h uid with + | exception Not_found -> Hashtbl.add h uid f + | _ when allow_overwrite -> Hashtbl.add h uid f + | g when eq f g -> () + | _ -> + user_err ~hdr:"prim_token_interpreter" + (str "Unique identifier " ++ str uid ++ + str " already used to register a numeral or string (un)interpreter.") + +let register_gen_interpretation allow_overwrite uid (interp, uninterp) = + hashtbl_check_and_set + allow_overwrite uid interp prim_token_interpreters InnerPrimToken.interp_eq; + hashtbl_check_and_set + allow_overwrite uid uninterp prim_token_uninterpreters InnerPrimToken.uninterp_eq + +let register_rawnumeral_interpretation ?(allow_overwrite=false) uid (interp, uninterp) = + register_gen_interpretation allow_overwrite uid + (InnerPrimToken.RawNumInterp interp, InnerPrimToken.RawNumUninterp uninterp) + +let register_bignumeral_interpretation ?(allow_overwrite=false) uid (interp, uninterp) = + register_gen_interpretation allow_overwrite uid + (InnerPrimToken.BigNumInterp interp, InnerPrimToken.BigNumUninterp uninterp) + +let register_string_interpretation ?(allow_overwrite=false) uid (interp, uninterp) = + register_gen_interpretation allow_overwrite uid + (InnerPrimToken.StringInterp interp, InnerPrimToken.StringUninterp uninterp) + +type prim_token_infos = { + pt_local : bool; (** Is this interpretation local? *) + pt_scope : scope_name; (** Concerned scope *) + pt_uid : prim_token_uid; (** Unique id "pointing" to (un)interp functions *) + pt_required : required_module; (** Module that should be loaded first *) + pt_refs : GlobRef.t list; (** Entry points during uninterpretation *) + pt_in_match : bool (** Is this prim token legal in match patterns ? *) +} + +let cache_prim_token_interpretation (_,infos) = + let sc = infos.pt_scope in + let uid = infos.pt_uid in + declare_scope sc; + prim_token_interp_infos := + String.Map.add sc (infos.pt_required,infos.pt_uid) !prim_token_interp_infos; + List.iter (fun r -> prim_token_uninterp_infos := + Refmap.add r (sc,uid,infos.pt_in_match) + !prim_token_uninterp_infos) + infos.pt_refs + +let subst_prim_token_interpretation (subs,infos) = + { infos with + pt_refs = List.map (subst_global_reference subs) infos.pt_refs } + +let classify_prim_token_interpretation infos = + if infos.pt_local then Dispose else Substitute infos + +let inPrimTokenInterp : prim_token_infos -> obj = + declare_object {(default_object "PRIM-TOKEN-INTERP") with + open_function = (fun i o -> if Int.equal i 1 then cache_prim_token_interpretation o); + cache_function = cache_prim_token_interpretation; + subst_function = subst_prim_token_interpretation; + classify_function = classify_prim_token_interpretation} + +let enable_prim_token_interpretation infos = + Lib.add_anonymous_leaf (inPrimTokenInterp infos) + +(** Compatibility. + Avoid the next two functions, they will now store unnecessary + objects in the library segment. Instead, combine + [register_*_interpretation] and [enable_prim_token_interpretation] + (the latter inside a [Mltop.declare_cache_obj]). +*) + +let fresh_string_of = + let count = ref 0 in + fun root -> count := !count+1; (string_of_int !count)^"_"^root + +let declare_numeral_interpreter ?(local=false) sc dir interp (patl,uninterp,b) = + let uid = fresh_string_of sc in + register_bignumeral_interpretation uid (interp,uninterp); + enable_prim_token_interpretation + { pt_local = local; + pt_scope = sc; + pt_uid = uid; + pt_required = dir; + pt_refs = List.map_filter glob_prim_constr_key patl; + pt_in_match = b } +let declare_string_interpreter ?(local=false) sc dir interp (patl,uninterp,b) = + let uid = fresh_string_of sc in + register_string_interpretation uid (interp,uninterp); + enable_prim_token_interpretation + { pt_local = local; + pt_scope = sc; + pt_uid = uid; + pt_required = dir; + pt_refs = List.map_filter glob_prim_constr_key patl; + pt_in_match = b } -let declare_rawnumeral_interpreter sc dir interp (patl,uninterp,inpat) = - declare_prim_token_interpreter sc - (fun cont ?loc -> function Numeral (n,s) -> delay dir interp ?loc (n,s) - | p -> cont ?loc p) - (patl, (fun r -> match uninterp r with - | None -> None - | Some (n,s) -> Some (Numeral (n,s))), inpat) - -let declare_numeral_interpreter sc dir interp (patl,uninterp,inpat) = - let interp' ?loc (n,s) = interp ?loc (ofNumeral n s) in - declare_prim_token_interpreter sc - (fun cont ?loc -> function Numeral (n,s) -> delay dir interp' ?loc (n,s) - | p -> cont ?loc p) - (patl, (fun r -> Option.map mkNumeral (uninterp r)), inpat) - -let declare_string_interpreter sc dir interp (patl,uninterp,inpat) = - declare_prim_token_interpreter sc - (fun cont ?loc -> function String s -> delay dir interp ?loc s | p -> cont ?loc p) - (patl, (fun r -> mkString (uninterp r)), inpat) let check_required_module ?loc sc (sp,d) = try let _ = Nametab.global_of_path sp in () with Not_found -> - user_err ?loc ~hdr:"prim_token_interpreter" - (str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".") + match d with + | [] -> user_err ?loc ~hdr:"prim_token_interpreter" + (str "Cannot interpret in " ++ str sc ++ str " because " ++ pr_path sp ++ str " could not be found in the current environment.") + | _ -> user_err ?loc ~hdr:"prim_token_interpreter" + (str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".") (* Look if some notation or numeral printer in [scope] can be used in the scope stack [scopes], and if yes, using delimiters or not *) @@ -476,9 +586,10 @@ let find_prim_token check_allowed ?loc p sc = pat, df with Not_found -> (* Try for a primitive numerical notation *) - let (spdir,interp) = Hashtbl.find prim_token_interpreter_tab sc ?loc p in + let (spdir,uid) = String.Map.find sc !prim_token_interp_infos in check_required_module ?loc sc spdir; - let pat = interp () in + let interp = Hashtbl.find prim_token_interpreters uid in + let pat = InnerPrimToken.do_interp ?loc interp p in check_allowed pat; pat, ((dirpath (fst spdir),DirPath.empty),"") @@ -649,43 +760,34 @@ let entry_has_ident = function try String.Map.find s !entry_has_ident_map <= n with Not_found -> false let uninterp_prim_token c = - try - let (sc,numpr,_) = - KeyMap.find (glob_prim_constr_key c) !prim_token_key_table in - match numpr (AnyGlobConstr c) with - | None -> raise Notation_ops.No_match - | Some n -> (sc,n) - with Not_found -> raise Notation_ops.No_match - -let uninterp_prim_token_ind_pattern ind args = - let ref = IndRef ind in - try - let k = RefKey (canonical_gr ref) in - let (sc,numpr,b) = KeyMap.find k !prim_token_key_table in - if not b then raise Notation_ops.No_match; - let args' = List.map - (fun x -> snd (glob_constr_of_closed_cases_pattern x)) args in - let ref = DAst.make @@ GRef (ref,None) in - match numpr (AnyGlobConstr (DAst.make @@ GApp (ref,args'))) with - | None -> raise Notation_ops.No_match - | Some n -> (sc,n) - with Not_found -> raise Notation_ops.No_match + match glob_prim_constr_key c with + | None -> raise Notation_ops.No_match + | Some r -> + try + let (sc,uid,_) = Refmap.find r !prim_token_uninterp_infos in + let uninterp = Hashtbl.find prim_token_uninterpreters uid in + match InnerPrimToken.do_uninterp uninterp (AnyGlobConstr c) with + | None -> raise Notation_ops.No_match + | Some n -> (sc,n) + with Not_found -> raise Notation_ops.No_match let uninterp_prim_token_cases_pattern c = - try - let k = cases_pattern_key c in - let (sc,numpr,b) = KeyMap.find k !prim_token_key_table in - if not b then raise Notation_ops.No_match; - let na,c = glob_constr_of_closed_cases_pattern c in - match numpr (AnyGlobConstr c) with - | None -> raise Notation_ops.No_match - | Some n -> (na,sc,n) - with Not_found -> raise Notation_ops.No_match + match glob_constr_of_closed_cases_pattern c with + | exception Not_found -> raise Notation_ops.No_match + | na,c -> let (sc,n) = uninterp_prim_token c in (na,sc,n) let availability_of_prim_token n printer_scope local_scopes = let f scope = - try ignore ((Hashtbl.find prim_token_interpreter_tab scope) n); true - with Not_found -> false in + try + let uid = snd (String.Map.find scope !prim_token_interp_infos) in + let interp = Hashtbl.find prim_token_interpreters uid in + let open InnerPrimToken in + match n, interp with + | Numeral _, (RawNumInterp _ | BigNumInterp _) -> true + | String _, StringInterp _ -> true + | _ -> false + with Not_found -> false + in let scopes = make_current_scopes local_scopes in Option.map snd (find_without_delimiters f (Some printer_scope,None) scopes) @@ -1206,16 +1308,19 @@ let pr_visibility prglob = function let freeze _ = (!scope_map, !scope_stack, !arguments_scope, !delimiters_map, !notations_key_table, !scope_class_map, + !prim_token_interp_infos, !prim_token_uninterp_infos, !entry_coercion_map, !entry_has_global_map, !entry_has_ident_map) -let unfreeze (scm,scs,asc,dlm,fkm,clsc,coe,globs,ids) = +let unfreeze (scm,scs,asc,dlm,fkm,clsc,ptii,ptui,coe,globs,ids) = scope_map := scm; scope_stack := scs; delimiters_map := dlm; arguments_scope := asc; notations_key_table := fkm; scope_class_map := clsc; + prim_token_interp_infos := ptii; + prim_token_uninterp_infos := ptui; entry_coercion_map := coe; entry_has_global_map := globs; entry_has_ident_map := ids @@ -1224,7 +1329,9 @@ let init () = init_scope_map (); delimiters_map := String.Map.empty; notations_key_table := KeyMap.empty; - scope_class_map := initial_scope_class_map + scope_class_map := initial_scope_class_map; + prim_token_interp_infos := String.Map.empty; + prim_token_uninterp_infos := Refmap.empty let _ = Summary.declare_summary "symbols" diff --git a/interp/notation.mli b/interp/notation.mli index c921606484..e5478eff48 100644 --- a/interp/notation.mli +++ b/interp/notation.mli @@ -8,7 +8,6 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -open Bigint open Names open Libnames open Constrexpr @@ -75,24 +74,62 @@ val find_delimiters_scope : ?loc:Loc.t -> delimiters -> scope_name type notation_location = (DirPath.t * DirPath.t) * string type required_module = full_path * string list -type cases_pattern_status = bool (** true = use prim token in patterns *) +type rawnum = Constrexpr.raw_natural_number * Constrexpr.sign -type 'a prim_token_interpreter = - ?loc:Loc.t -> 'a -> glob_constr +(** The unique id string below will be used to refer to a particular + registered interpreter/uninterpreter of numeral or string notation. + Using the same uid for different (un)interpreters will fail. + If at most one interpretation of prim token is used per scope, + then the scope name could be used as unique id. *) -type 'a prim_token_uninterpreter = - glob_constr list * (any_glob_constr -> 'a option) * cases_pattern_status +type prim_token_uid = string -type rawnum = Constrexpr.raw_natural_number * Constrexpr.sign +type 'a prim_token_interpreter = ?loc:Loc.t -> 'a -> glob_constr +type 'a prim_token_uninterpreter = any_glob_constr -> 'a option + +type 'a prim_token_interpretation = + 'a prim_token_interpreter * 'a prim_token_uninterpreter + +val register_rawnumeral_interpretation : + ?allow_overwrite:bool -> prim_token_uid -> rawnum prim_token_interpretation -> unit + +val register_bignumeral_interpretation : + ?allow_overwrite:bool -> prim_token_uid -> Bigint.bigint prim_token_interpretation -> unit + +val register_string_interpretation : + ?allow_overwrite:bool -> prim_token_uid -> string prim_token_interpretation -> unit + +type prim_token_infos = { + pt_local : bool; (** Is this interpretation local? *) + pt_scope : scope_name; (** Concerned scope *) + pt_uid : prim_token_uid; (** Unique id "pointing" to (un)interp functions *) + pt_required : required_module; (** Module that should be loaded first *) + pt_refs : GlobRef.t list; (** Entry points during uninterpretation *) + pt_in_match : bool (** Is this prim token legal in match patterns ? *) +} + +(** Note: most of the time, the [pt_refs] field above will contain + inductive constructors (e.g. O and S for nat). But it could also be + injection functions such as IZR for reals. *) + +(** Activate a prim token interpretation whose unique id and functions + have already been registered. *) -val declare_rawnumeral_interpreter : scope_name -> required_module -> - rawnum prim_token_interpreter -> rawnum prim_token_uninterpreter -> unit +val enable_prim_token_interpretation : prim_token_infos -> unit -val declare_numeral_interpreter : scope_name -> required_module -> - bigint prim_token_interpreter -> bigint prim_token_uninterpreter -> unit +(** Compatibility. + Avoid the next two functions, they will now store unnecessary + objects in the library segment. Instead, combine + [register_*_interpretation] and [enable_prim_token_interpretation] + (the latter inside a [Mltop.declare_cache_obj]). +*) -val declare_string_interpreter : scope_name -> required_module -> - string prim_token_interpreter -> string prim_token_uninterpreter -> unit +val declare_numeral_interpreter : ?local:bool -> scope_name -> required_module -> + Bigint.bigint prim_token_interpreter -> + glob_constr list * Bigint.bigint prim_token_uninterpreter * bool -> unit +val declare_string_interpreter : ?local:bool -> scope_name -> required_module -> + string prim_token_interpreter -> + glob_constr list * string prim_token_uninterpreter * bool -> unit (** Return the [term]/[cases_pattern] bound to a primitive token in a given scope context*) @@ -110,8 +147,6 @@ val uninterp_prim_token : 'a glob_constr_g -> scope_name * prim_token val uninterp_prim_token_cases_pattern : 'a cases_pattern_g -> Name.t * scope_name * prim_token -val uninterp_prim_token_ind_pattern : - inductive -> cases_pattern list -> scope_name * prim_token val availability_of_prim_token : prim_token -> scope_name -> subscopes -> delimiters option option diff --git a/kernel/byterun/dune b/kernel/byterun/dune new file mode 100644 index 0000000000..3a714a8a59 --- /dev/null +++ b/kernel/byterun/dune @@ -0,0 +1,10 @@ +(library + (name byterun) + (synopsis "Coq's Kernel Abstract Reduction Machine [C implementation]") + (public_name coq.vm) + (c_names coq_fix_code coq_memory coq_values coq_interp)) + +(rule + (targets coq_jumptbl.h) + (deps (:h-file coq_instruct.h)) + (action (run ./make_jumptbl.sh %{h-file} %{targets}))) diff --git a/kernel/byterun/make_jumptbl.sh b/kernel/byterun/make_jumptbl.sh new file mode 100755 index 0000000000..eacd4daac8 --- /dev/null +++ b/kernel/byterun/make_jumptbl.sh @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +sed -n -e '/^ /s/ \([A-Z]\)/ \&\&coq_lbl_\1/gp' -e '/^}/q' ${1} > ${2} diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml index ac4c6c52c6..fd9394025a 100644 --- a/kernel/cClosure.ml +++ b/kernel/cClosure.ml @@ -31,7 +31,6 @@ open Environ open Esubst let stats = ref false -let share = ref true (* Profiling *) let beta = ref 0 @@ -266,6 +265,7 @@ type 'a infos_cache = { i_env : env; i_sigma : existential -> constr option; i_rels : (Constr.rel_declaration * lazy_val) Range.t; + i_share : bool; } and 'a infos = { @@ -313,12 +313,13 @@ let ref_value_cache ({i_cache = cache} as infos) tab ref = let evar_value cache ev = cache.i_sigma ev -let create mk_cl flgs env evars = +let create ~repr ~share flgs env evars = let cache = - { i_repr = mk_cl; + { i_repr = repr; i_env = env; i_sigma = evars; i_rels = env.env_rel_context.env_rel_map; + i_share = share; } in { i_flags = flgs; i_cache = cache } @@ -384,8 +385,8 @@ let mk_red f = {norm=Red;term=f} (* Could issue a warning if no is still Red, pointing out that we loose sharing. *) -let update v1 no t = - if !share then +let update ~share v1 no t = + if share then (v1.norm <- no; v1.term <- t; v1) @@ -498,14 +499,16 @@ let compact_stack head stk = (* Be sure to create a new cell otherwise sharing would be lost by the update operation *) let h' = lft_fconstr depth head in - let _ = update m h'.norm h'.term in + (** The stack contains [Zupdate] marks only if in sharing mode *) + let _ = update ~share:true m h'.norm h'.term in strip_rec depth s | stk -> zshift depth stk in strip_rec 0 stk (* Put an update mark in the stack, only if needed *) -let zupdate m s = - if !share && begin match m.norm with Red -> true | _ -> false end +let zupdate info m s = + let share = info.i_cache.i_share in + if share && begin match m.norm with Red -> true | _ -> false end then let s' = compact_stack m s in let _ = m.term <- FLOCKED in @@ -698,7 +701,8 @@ let rec zip m stk = | Zshift(n)::s -> zip (lift_fconstr n m) s | Zupdate(rf)::s -> - zip (update rf m.norm m.term) s + (** The stack contains [Zupdate] marks only if in sharing mode *) + zip (update ~share:true rf m.norm m.term) s let fapp_stack (m,stk) = zip m stk @@ -718,7 +722,8 @@ let strip_update_shift_app_red head stk = strip_rec (Zapp args :: rstk) {norm=h.norm;term=FApp(h,args)} depth s | Zupdate(m)::s -> - strip_rec rstk (update m h.norm h.term) depth s + (** The stack contains [Zupdate] marks only if in sharing mode *) + strip_rec rstk (update ~share:true m h.norm h.term) depth s | stk -> (depth,List.rev rstk, stk) in strip_rec [] head 0 stk @@ -743,7 +748,8 @@ let get_nth_arg head n stk = List.rev (if Int.equal n 0 then rstk else (Zapp bef :: rstk)) in (Some (stk', args.(n)), append_stack aft s') | Zupdate(m)::s -> - strip_rec rstk (update m h.norm h.term) n s + (** The stack contains [Zupdate] mark only if in sharing mode *) + strip_rec rstk (update ~share:true m h.norm h.term) n s | s -> (None, List.rev rstk @ s) in strip_rec [] head n stk @@ -752,7 +758,8 @@ let get_nth_arg head n stk = let rec get_args n tys f e stk = match stk with Zupdate r :: s -> - let _hd = update r Cstr (FLambda(n,tys,f,e)) in + (** The stack contains [Zupdate] mark only if in sharing mode *) + let _hd = update ~share:true r Cstr (FLambda(n,tys,f,e)) in get_args n tys f e s | Zshift k :: s -> get_args n tys f (subs_shft (k,e)) s @@ -889,10 +896,10 @@ let unfold_projection info p = let rec knh info m stk = match m.term with | FLIFT(k,a) -> knh info a (zshift k stk) - | FCLOS(t,e) -> knht info e t (zupdate m stk) + | FCLOS(t,e) -> knht info e t (zupdate info m stk) | FLOCKED -> assert false - | FApp(a,b) -> knh info a (append_stack b (zupdate m stk)) - | FCaseT(ci,p,t,br,e) -> knh info t (ZcaseT(ci,p,br,e)::zupdate m stk) + | FApp(a,b) -> knh info a (append_stack b (zupdate info m stk)) + | FCaseT(ci,p,t,br,e) -> knh info t (ZcaseT(ci,p,br,e)::zupdate info m stk) | FFix(((ri,n),(_,_,_)),_) -> (match get_nth_arg m ri.(n) stk with (Some(pars,arg),stk') -> knh info arg (Zfix(m,pars)::stk') @@ -901,7 +908,7 @@ let rec knh info m stk = | FProj (p,c) -> (match unfold_projection info p with | None -> (m, stk) - | Some s -> knh info c (s :: zupdate m stk)) + | Some s -> knh info c (s :: zupdate info m stk)) (* cases where knh stops *) | (FFlex _|FLetIn _|FConstruct _|FEvar _| @@ -1019,10 +1026,11 @@ let rec zip_term zfun m stk = 2- tries to rebuild the term. If a closure still has to be computed, calls itself recursively. *) let rec kl info tab m = + let share = info.i_cache.i_share in if is_val m then (incr prune; term_of_fconstr m) else let (nm,s) = kni info tab m [] in - let () = if !share then ignore (fapp_stack (nm, s)) in (* to unlock Zupdates! *) + let () = if share then ignore (fapp_stack (nm, s)) in (* to unlock Zupdates! *) zip_term (kl info tab) (norm_head info tab nm) s (* no redex: go up for atoms and already normalized terms, go down @@ -1078,14 +1086,15 @@ let whd_stack infos tab m stk = match m.norm with knh infos m stk | Red | Cstr -> let k = kni infos tab m stk in - let () = if !share then ignore (fapp_stack k) in (* to unlock Zupdates! *) + let () = if infos.i_cache.i_share then ignore (fapp_stack k) in (* to unlock Zupdates! *) k (* cache of constants: the body is computed only when needed. *) type clos_infos = fconstr infos let create_clos_infos ?(evars=fun _ -> None) flgs env = - create (fun _ _ c -> inject c) flgs env evars + let share = (Environ.typing_flags env).Declarations.share_reduction in + create ~share ~repr:(fun _ _ c -> inject c) flgs env evars let create_tab () = KeyTable.create 17 diff --git a/kernel/cClosure.mli b/kernel/cClosure.mli index 1e3e7b48ac..6121b3a1ec 100644 --- a/kernel/cClosure.mli +++ b/kernel/cClosure.mli @@ -15,7 +15,6 @@ open Esubst (** Flags for profiling reductions. *) val stats : bool ref -val share : bool ref val with_stats: 'a Lazy.t -> 'a @@ -106,8 +105,13 @@ type 'a infos = { i_cache : 'a infos_cache } val ref_value_cache: 'a infos -> 'a infos_tab -> table_key -> 'a option -val create: ('a infos -> 'a infos_tab -> constr -> 'a) -> reds -> env -> - (existential -> constr option) -> 'a infos +val create: + repr:('a infos -> 'a infos_tab -> constr -> 'a) -> + share:bool -> + reds -> + env -> + (existential -> constr option) -> + 'a infos val create_tab : unit -> 'a infos_tab val evar_value : 'a infos_cache -> existential -> constr option diff --git a/kernel/cooking.ml b/kernel/cooking.ml index c06358054e..657478a106 100644 --- a/kernel/cooking.ml +++ b/kernel/cooking.ml @@ -24,6 +24,7 @@ open Declarations open Univ module NamedDecl = Context.Named.Declaration +module RelDecl = Context.Rel.Declaration (*s Cooking the constants. *) @@ -140,11 +141,31 @@ let expmod_constr cache modlist c = if is_empty_modlist modlist then c else substrec c -let abstract_constant_type = - List.fold_left (fun c d -> mkNamedProd_wo_LetIn d c) +(** Transforms a named context into a rel context. Also returns the list of + variables [id1 ... idn] that need to be replaced by [Rel 1 ... Rel n] to + abstract a term that lived in that context. *) +let abstract_context hyps = + let fold decl (ctx, subst) = + let id, decl = match decl with + | NamedDecl.LocalDef (id, b, t) -> + let b = Vars.subst_vars subst b in + let t = Vars.subst_vars subst t in + id, RelDecl.LocalDef (Name id, b, t) + | NamedDecl.LocalAssum (id, t) -> + let t = Vars.subst_vars subst t in + id, RelDecl.LocalAssum (Name id, t) + in + (decl :: ctx, id :: subst) + in + Context.Named.fold_outside fold hyps ~init:([], []) + +let abstract_constant_type t (hyps, subst) = + let t = Vars.subst_vars subst t in + List.fold_left (fun c d -> mkProd_wo_LetIn d c) t hyps -let abstract_constant_body = - List.fold_left (fun c d -> mkNamedLambda_or_LetIn d c) +let abstract_constant_body c (hyps, subst) = + let c = Vars.subst_vars subst c in + it_mkLambda_or_LetIn c hyps type recipe = { from : constant_body; info : Opaqueproof.cooking_info } type inline = bool @@ -173,6 +194,7 @@ let cook_constr { Opaqueproof.modlist ; abstract = (vars, subst, _) } c = let cache = RefTable.create 13 in let expmod = expmod_constr_subst cache modlist subst in let hyps = Context.Named.map expmod vars in + let hyps = abstract_context hyps in abstract_constant_body (expmod c) hyps let lift_univs cb subst auctx0 = @@ -207,12 +229,13 @@ let cook_constant ~hcons { from = cb; info } = let abstract, usubst, abs_ctx = abstract in let usubst, univs = lift_univs cb usubst abs_ctx in let expmod = expmod_constr_subst cache modlist usubst in - let hyps = Context.Named.map expmod abstract in + let hyps0 = Context.Named.map expmod abstract in + let hyps = abstract_context hyps0 in let map c = let c = abstract_constant_body (expmod c) hyps in if hcons then Constr.hcons c else c in - let body = on_body modlist (hyps, usubst, abs_ctx) + let body = on_body modlist (hyps0, usubst, abs_ctx) map cb.const_body in @@ -220,7 +243,7 @@ let cook_constant ~hcons { from = cb; info } = Context.Named.fold_outside (fun decl hyps -> List.filter (fun decl' -> not (Id.equal (NamedDecl.get_id decl) (NamedDecl.get_id decl'))) hyps) - hyps ~init:cb.const_hyps in + hyps0 ~init:cb.const_hyps in let typ = abstract_constant_type (expmod cb.const_type) hyps in { cook_body = body; diff --git a/kernel/declarations.ml b/kernel/declarations.ml index 0811eb72fd..1d49550442 100644 --- a/kernel/declarations.ml +++ b/kernel/declarations.ml @@ -65,6 +65,7 @@ type typing_flags = { points are assumed to be total. *) check_universes : bool; (** If [false] universe constraints are not checked *) conv_oracle : Conv_oracle.oracle; (** Unfolding strategies for conversion *) + share_reduction : bool; (** Use by-need reduction algorithm *) } (* some contraints are in constant_constraints, some other may be in diff --git a/kernel/declareops.ml b/kernel/declareops.ml index bbe4bc0dcb..51ec3defb3 100644 --- a/kernel/declareops.ml +++ b/kernel/declareops.ml @@ -21,6 +21,7 @@ let safe_flags oracle = { check_guarded = true; check_universes = true; conv_oracle = oracle; + share_reduction = true; } (** {6 Arities } *) @@ -305,13 +306,6 @@ let hcons_mind mib = mind_params_ctxt = hcons_rel_context mib.mind_params_ctxt; mind_universes = hcons_mind_universes mib.mind_universes } -(** {6 Stm machinery } *) - -let string_of_side_effect { Entries.eff } = match eff with - | Entries.SEsubproof (c,_,_) -> "P(" ^ Names.Constant.to_string c ^ ")" - | Entries.SEscheme (cl,_) -> - "S(" ^ String.concat ", " (List.map (fun (_,c,_,_) -> Names.Constant.to_string c) cl) ^ ")" - (** Hashconsing of modules *) let hcons_functorize hty he hself f = match f with diff --git a/kernel/declareops.mli b/kernel/declareops.mli index f91e69807f..35490ceef9 100644 --- a/kernel/declareops.mli +++ b/kernel/declareops.mli @@ -11,7 +11,6 @@ open Declarations open Mod_subst open Univ -open Entries (** Operations concerning types in [Declarations] : [constant_body], [mutual_inductive_body], [module_body] ... *) @@ -39,10 +38,6 @@ val constant_is_polymorphic : constant_body -> bool val is_opaque : constant_body -> bool -(** Side effects *) - -val string_of_side_effect : side_effect -> string - (** {6 Inductive types} *) val eq_recarg : recarg -> recarg -> bool diff --git a/kernel/dune b/kernel/dune new file mode 100644 index 0000000000..011af9c28c --- /dev/null +++ b/kernel/dune @@ -0,0 +1,15 @@ +(library + (name kernel) + (synopsis "The Coq Kernel") + (public_name coq.kernel) + (wrapped false) + (modules_without_implementation cinstr nativeinstr) + (libraries clib config lib byterun)) + +(rule + (targets copcodes.ml) + (deps (:h-file byterun/coq_instruct.h) make-opcodes) + (action (run ./make_opcodes.sh %{h-file} %{targets}))) + +(documentation + (package coq)) diff --git a/kernel/entries.ml b/kernel/entries.ml index 40873bea76..94248ad26b 100644 --- a/kernel/entries.ml +++ b/kernel/entries.ml @@ -120,11 +120,14 @@ type seff_env = Same as the constant_body's but not in an ephemeron *) | `Opaque of Constr.t * Univ.ContextSet.t ] -type side_eff = - | SEsubproof of Constant.t * Declarations.constant_body * seff_env - | SEscheme of (inductive * Constant.t * Declarations.constant_body * seff_env) list * string - -type side_effect = { - from_env : Declarations.structure_body CEphemeron.key; - eff : side_eff; +(** Not used by the kernel. *) +type side_effect_role = + | Subproof + | Schema of inductive * string + +type side_eff = { + seff_constant : Constant.t; + seff_body : Declarations.constant_body; + seff_env : seff_env; + seff_role : side_effect_role; } diff --git a/kernel/make_opcodes.sh b/kernel/make_opcodes.sh new file mode 100755 index 0000000000..bb8aba2f07 --- /dev/null +++ b/kernel/make_opcodes.sh @@ -0,0 +1,4 @@ +#!/usr/bin/env bash + +script_dir="$(dirname "$0")" +tr -d "\r" < "${1}" | sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' | awk -f "$script_dir"/make-opcodes > "${2}" diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml index cc35a70cbf..ad10c86945 100644 --- a/kernel/nativecode.ml +++ b/kernel/nativecode.ml @@ -1067,12 +1067,11 @@ let ml_of_instance instance u = let tyn = fresh_lname Anonymous in let i = push_symbol (SymbMeta mv) in MLapp(MLprimitive Mk_meta, [|get_meta_code i; MLlocal tyn|]) - | Levar(evk,ty,args) -> - let tyn = fresh_lname Anonymous in + | Levar(evk, args) -> let i = push_symbol (SymbEvar evk) in + (** Arguments are *not* reversed in evar instances in native compilation *) let args = MLarray(Array.map (ml_of_lam env l) args) in - MLlet(tyn, ml_of_lam env l ty, - MLapp(MLprimitive Mk_evar, [|get_evar_code i;MLlocal tyn; args|])) + MLapp(MLprimitive Mk_evar, [|get_evar_code i; args|]) | Lprod(dom,codom) -> let dom = ml_of_lam env l dom in let codom = ml_of_lam env l codom in @@ -1749,7 +1748,7 @@ let pp_mllam fmt l = | Mk_cofix(start) -> Format.fprintf fmt "mk_cofix_accu %i" start | Mk_rel i -> Format.fprintf fmt "mk_rel_accu %i" i | Mk_var id -> - Format.fprintf fmt "mk_var_accu (Names.id_of_string \"%s\")" (string_of_id id) + Format.fprintf fmt "mk_var_accu (Names.Id.of_string \"%s\")" (string_of_id id) | Mk_proj -> Format.fprintf fmt "mk_proj_accu" | Is_int -> Format.fprintf fmt "is_int" | Cast_accu -> Format.fprintf fmt "cast_accu" diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml index 931b8bbc86..c75dde843e 100644 --- a/kernel/nativeconv.ml +++ b/kernel/nativeconv.ml @@ -64,7 +64,7 @@ and conv_atom env pb lvl a1 a2 cu = match a1, a2 with | Ameta (m1,_), Ameta (m2,_) -> if Int.equal m1 m2 then cu else raise NotConvertible - | Aevar (ev1,_,args1), Aevar (ev2,_,args2) -> + | Aevar (ev1, args1), Aevar (ev2, args2) -> if Evar.equal ev1 ev2 then Array.fold_right2 (conv_val env CONV lvl) args1 args2 cu else raise NotConvertible diff --git a/kernel/nativeinstr.mli b/kernel/nativeinstr.mli index 5075bd3d14..2d8e2ba2f0 100644 --- a/kernel/nativeinstr.mli +++ b/kernel/nativeinstr.mli @@ -25,7 +25,7 @@ and lambda = | Lrel of Name.t * int | Lvar of Id.t | Lmeta of metavariable * lambda (* type *) - | Levar of Evar.t * lambda (* type *) * lambda array (* arguments *) + | Levar of Evar.t * lambda array (* arguments *) | Lprod of lambda * lambda | Llam of Name.t array * lambda | Llet of Name.t * lambda * lambda diff --git a/kernel/nativelambda.ml b/kernel/nativelambda.ml index cec0ee57d5..122fe95df4 100644 --- a/kernel/nativelambda.ml +++ b/kernel/nativelambda.ml @@ -23,7 +23,6 @@ exception NotClosed type evars = { evars_val : existential -> constr option; - evars_typ : existential -> types; evars_metas : metavariable -> types } (*s Constructors *) @@ -88,7 +87,7 @@ let get_const_prefix env c = let rec map_lam_with_binders g f n lam = match lam with | Lrel _ | Lvar _ | Lconst _ | Lproj _ | Lval _ | Lsort _ | Lind _ - | Lconstruct _ | Llazy | Lforce | Lmeta _ | Levar _ -> lam + | Lconstruct _ | Llazy | Lforce | Lmeta _ -> lam | Lprod(dom,codom) -> let dom' = f n dom in let codom' = f n codom in @@ -139,6 +138,9 @@ let rec map_lam_with_binders g f n lam = | Luint u -> let u' = map_uint g f n u in if u == u' then lam else Luint u' + | Levar (evk, args) -> + let args' = Array.Smart.map (f n) args in + if args == args' then lam else Levar (evk, args') and map_uint g f n u = match u with @@ -386,13 +388,10 @@ let is_lazy env prefix t = let evar_value sigma ev = sigma.evars_val ev -let evar_type sigma ev = sigma.evars_typ ev - let meta_type sigma mv = sigma.evars_metas mv let empty_evars = { evars_val = (fun _ -> None); - evars_typ = (fun _ -> assert false); evars_metas = (fun _ -> assert false) } let empty_ids = [||] @@ -420,9 +419,8 @@ let rec lambda_of_constr cache env sigma c = | Evar (evk,args as ev) -> (match evar_value sigma ev with | None -> - let ty = evar_type sigma ev in let args = Array.map (lambda_of_constr cache env sigma) args in - Levar(evk, lambda_of_constr cache env sigma ty, args) + Levar(evk, args) | Some t -> lambda_of_constr cache env sigma t) | Cast (c, _, _) -> lambda_of_constr cache env sigma c diff --git a/kernel/nativelambda.mli b/kernel/nativelambda.mli index efe1700cd7..7b20258929 100644 --- a/kernel/nativelambda.mli +++ b/kernel/nativelambda.mli @@ -15,7 +15,6 @@ open Nativeinstr (** This file defines the lambda code generation phase of the native compiler *) type evars = { evars_val : existential -> constr option; - evars_typ : existential -> types; evars_metas : metavariable -> types } val empty_evars : evars diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml index 91f6add1c3..3bf23f1468 100644 --- a/kernel/nativevalues.ml +++ b/kernel/nativevalues.ml @@ -63,7 +63,7 @@ type atom = | Acofixe of t array * t array * int * t | Aprod of Name.t * t * (t -> t) | Ameta of metavariable * t - | Aevar of Evar.t * t * t array + | Aevar of Evar.t * t array | Aproj of (inductive * int) * accumulator let accumulate_tag = 0 @@ -135,8 +135,8 @@ let mk_prod_accu s dom codom = let mk_meta_accu mv ty = mk_accu (Ameta (mv,ty)) -let mk_evar_accu ev ty args = - mk_accu (Aevar (ev,ty,args)) +let mk_evar_accu ev args = + mk_accu (Aevar (ev, args)) let mk_proj_accu kn c = mk_accu (Aproj (kn,c)) diff --git a/kernel/nativevalues.mli b/kernel/nativevalues.mli index 6bbf15160c..10689941e8 100644 --- a/kernel/nativevalues.mli +++ b/kernel/nativevalues.mli @@ -53,7 +53,7 @@ type atom = | Acofixe of t array * t array * int * t | Aprod of Name.t * t * (t -> t) | Ameta of metavariable * t - | Aevar of Evar.t * t (* type *) * t array (* arguments *) + | Aevar of Evar.t * t array (* arguments *) | Aproj of (inductive * int) * accumulator (* Constructors *) @@ -70,7 +70,7 @@ val mk_prod_accu : Name.t -> t -> t -> t val mk_fix_accu : rec_pos -> int -> t array -> t array -> t val mk_cofix_accu : int -> t array -> t array -> t val mk_meta_accu : metavariable -> t -val mk_evar_accu : Evar.t -> t -> t array -> t +val mk_evar_accu : Evar.t -> t array -> t val mk_proj_accu : (inductive * int) -> accumulator -> t val upd_cofix : t -> t -> unit val force_cofix : t -> t diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml index f87ec9e023..6c87ff570f 100644 --- a/kernel/safe_typing.ml +++ b/kernel/safe_typing.ml @@ -210,13 +210,8 @@ let get_opaque_body env cbo = (Opaqueproof.force_proof (Environ.opaque_tables env) opaque, Opaqueproof.force_constraints (Environ.opaque_tables env) opaque) -type private_constant = Entries.side_effect type private_constants = Term_typing.side_effects -type private_constant_role = Term_typing.side_effect_role = - | Subproof - | Schema of inductive * string - let empty_private_constants = Term_typing.empty_seff let add_private = Term_typing.add_seff let concat_private = Term_typing.concat_seff @@ -225,44 +220,38 @@ let inline_private_constants_in_constr = Term_typing.inline_side_effects let inline_private_constants_in_definition_entry = Term_typing.inline_entry_side_effects let side_effects_of_private_constants = Term_typing.uniq_seff +let make_eff env cst r = + let open Entries in + let cbo = Environ.lookup_constant cst env.env in + { + seff_constant = cst; + seff_body = cbo; + seff_env = get_opaque_body env.env cbo; + seff_role = r; + } + let private_con_of_con env c = - let cbo = Environ.lookup_constant c env.env in - { Entries.from_env = CEphemeron.create env.revstruct; - Entries.eff = Entries.SEsubproof (c,cbo,get_opaque_body env.env cbo) } + let open Entries in + let eff = [make_eff env c Subproof] in + add_private env.revstruct eff empty_private_constants let private_con_of_scheme ~kind env cl = - { Entries.from_env = CEphemeron.create env.revstruct; - Entries.eff = Entries.SEscheme( - List.map (fun (i,c) -> - let cbo = Environ.lookup_constant c env.env in - i, c, cbo, get_opaque_body env.env cbo) cl, - kind) } + let open Entries in + let eff = List.map (fun (i, c) -> make_eff env c (Schema (i, kind))) cl in + add_private env.revstruct eff empty_private_constants let universes_of_private eff = - let open Declarations in - List.fold_left - (fun acc { Entries.eff } -> - match eff with - | Entries.SEscheme (l,s) -> - List.fold_left - (fun acc (_,_,cb,c) -> - let acc = match c with - | `Nothing -> acc - | `Opaque (_, ctx) -> ctx :: acc - in - match cb.const_universes with - | Monomorphic_const ctx -> - ctx :: acc - | Polymorphic_const _ -> acc - ) - acc l - | Entries.SEsubproof (c, cb, e) -> - match cb.const_universes with - | Monomorphic_const ctx -> - ctx :: acc - | Polymorphic_const _ -> acc - ) - [] (Term_typing.uniq_seff eff) + let open Entries in + let fold acc eff = + let acc = match eff.seff_env with + | `Nothing -> acc + | `Opaque (_, ctx) -> ctx :: acc + in + match eff.seff_body.const_universes with + | Monomorphic_const ctx -> ctx :: acc + | Polymorphic_const _ -> acc + in + List.fold_left fold [] (Term_typing.uniq_seff eff) let env_of_safe_env senv = senv.env let env_of_senv = env_of_safe_env @@ -489,7 +478,7 @@ type global_declaration = | GlobalRecipe of Cooking.recipe type exported_private_constant = - Constant.t * private_constant_role + Constant.t * Entries.side_effect_role let add_constant_aux no_section senv (kn, cb) = let l = pi3 (Constant.repr3 kn) in diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli index aca77ccd13..502e2970a1 100644 --- a/kernel/safe_typing.mli +++ b/kernel/safe_typing.mli @@ -41,29 +41,20 @@ type 'a safe_transformer = safe_environment -> 'a * safe_environment (** {6 Stm machinery } *) -type private_constant type private_constants -type private_constant_role = - | Subproof - | Schema of inductive * string - val side_effects_of_private_constants : - private_constants -> Entries.side_effect list + private_constants -> Entries.side_eff list (** Return the list of individual side-effects in the order of their creation. *) val empty_private_constants : private_constants -val add_private : private_constant -> private_constants -> private_constants -(** Add a constant to a list of private constants. The former must be more - recent than all constants appearing in the latter, i.e. one should not - create a dependency cycle. *) val concat_private : private_constants -> private_constants -> private_constants (** [concat_private e1 e2] adds the constants of [e1] to [e2], i.e. constants in [e1] must be more recent than those of [e2]. *) -val private_con_of_con : safe_environment -> Constant.t -> private_constant -val private_con_of_scheme : kind:string -> safe_environment -> (inductive * Constant.t) list -> private_constant +val private_con_of_con : safe_environment -> Constant.t -> private_constants +val private_con_of_scheme : kind:string -> safe_environment -> (inductive * Constant.t) list -> private_constants val mk_pure_proof : Constr.constr -> private_constants Entries.proof_output val inline_private_constants_in_constr : @@ -105,7 +96,7 @@ type global_declaration = | GlobalRecipe of Cooking.recipe type exported_private_constant = - Constant.t * private_constant_role + Constant.t * Entries.side_effect_role val export_private_constants : in_section:bool -> private_constants Entries.definition_entry -> diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml index 1f7ee145a2..43351737e5 100644 --- a/kernel/term_typing.ml +++ b/kernel/term_typing.ml @@ -27,16 +27,10 @@ module NamedDecl = Context.Named.Declaration (* Insertion of constants and parameters in environment. *) -let equal_eff e1 e2 = - let open Entries in - match e1, e2 with - | { eff = SEsubproof (c1,_,_) }, { eff = SEsubproof (c2,_,_) } -> - Names.Constant.equal c1 c2 - | { eff = SEscheme (cl1,_) }, { eff = SEscheme (cl2,_) } -> - CList.for_all2eq - (fun (_,c1,_,_) (_,c2,_,_) -> Names.Constant.equal c1 c2) - cl1 cl2 - | _ -> false +type side_effect = { + from_env : Declarations.structure_body CEphemeron.key; + eff : side_eff list; +} module SideEffects : sig @@ -48,17 +42,11 @@ sig end = struct -let compare_seff e1 e2 = match e1, e2 with -| SEsubproof (c1, _, _), SEsubproof (c2, _, _) -> Constant.CanOrd.compare c1 c2 -| SEscheme (cl1, _), SEscheme (cl2, _) -> - let cmp (_, c1, _, _) (_, c2, _, _) = Constant.CanOrd.compare c1 c2 in - CList.compare cmp cl1 cl2 -| SEsubproof _, SEscheme _ -> -1 -| SEscheme _, SEsubproof _ -> 1 - module SeffOrd = struct type t = side_effect -let compare e1 e2 = compare_seff e1.eff e2.eff +let compare e1 e2 = + let cmp e1 e2 = Constant.CanOrd.compare e1.seff_constant e2.seff_constant in + List.compare cmp e1.eff e2.eff end module SeffSet = Set.Make(SeffOrd) @@ -83,10 +71,14 @@ type _ trust = | SideEffects : structure_body -> side_effects trust let uniq_seff_rev = SideEffects.repr -let uniq_seff l = List.rev (SideEffects.repr l) +let uniq_seff l = + let ans = List.rev (SideEffects.repr l) in + List.map_append (fun { eff } -> eff) ans let empty_seff = SideEffects.empty -let add_seff = SideEffects.add +let add_seff mb eff effs = + let from_env = CEphemeron.create mb in + SideEffects.add { eff; from_env } effs let concat_seff = SideEffects.concat let mk_pure_proof c = (c, Univ.ContextSet.empty), empty_seff @@ -94,11 +86,8 @@ let mk_pure_proof c = (c, Univ.ContextSet.empty), empty_seff let inline_side_effects env body ctx side_eff = (** First step: remove the constants that are still in the environment *) let filter { eff = se; from_env = mb } = - let cbl = match se with - | SEsubproof (c, cb, b) -> [c, cb, b] - | SEscheme (cl,_) -> - List.map (fun (_, c, cb, b) -> c, cb, b) cl - in + let map e = (e.seff_constant, e.seff_body, e.seff_env) in + let cbl = List.map map se in let not_exists (c,_,_) = try ignore(Environ.lookup_constant c env); false with Not_found -> true in @@ -468,58 +457,50 @@ let constant_entry_of_side_effect cb u = const_entry_inline_code = cb.const_inline_code } ;; -let turn_direct (kn,cb,u,r as orig) = - match cb.const_body, u with - | OpaqueDef _, `Opaque (b,c) -> - let pt = Future.from_val (b,c) in - kn, { cb with const_body = OpaqueDef (Opaqueproof.create pt) }, u, r - | _ -> orig -;; - -type side_effect_role = - | Subproof - | Schema of inductive * string +let turn_direct orig = + let cb = orig.seff_body in + if Declareops.is_opaque cb then + let p = match orig.seff_env with + | `Opaque (b, c) -> (b, c) + | _ -> assert false + in + let const_body = OpaqueDef (Opaqueproof.create (Future.from_val p)) in + let cb = { cb with const_body } in + { orig with seff_body = cb } + else orig type exported_side_effect = Constant.t * constant_body * side_effect_role +let export_eff eff = + (eff.seff_constant, eff.seff_body, eff.seff_role) + let export_side_effects mb env c = let { const_entry_body = body } = c in let _, eff = Future.force body in let ce = { c with const_entry_body = Future.chain body (fun (b_ctx, _) -> b_ctx, ()) } in - let not_exists (c,_,_,_) = - try ignore(Environ.lookup_constant c env); false + let not_exists e = + try ignore(Environ.lookup_constant e.seff_constant env); false with Not_found -> true in let aux (acc,sl) { eff = se; from_env = mb } = - let cbl = match se with - | SEsubproof (c,cb,b) -> [c,cb,b,Subproof] - | SEscheme (cl,k) -> - List.map (fun (i,c,cb,b) -> c,cb,b,Schema(i,k)) cl in - let cbl = List.filter not_exists cbl in - if cbl = [] then acc, sl + let cbl = List.filter not_exists se in + if List.is_empty cbl then acc, sl else cbl :: acc, (mb,List.length cbl) :: sl in let seff, signatures = List.fold_left aux ([],[]) (uniq_seff_rev eff) in let trusted = check_signatures mb signatures in - let push_seff env = function - | kn, cb, `Nothing, _ -> - begin - let env = Environ.add_constant kn cb env in - match cb.const_universes with - | Monomorphic_const ctx -> - Environ.push_context_set ~strict:true ctx env - | Polymorphic_const _ -> env - end - | kn, cb, `Opaque(_, ctx), _ -> - begin - let env = Environ.add_constant kn cb env in - match cb.const_universes with - | Monomorphic_const cstctx -> - let env = Environ.push_context_set ~strict:true cstctx env in - Environ.push_context_set ~strict:true ctx env - | Polymorphic_const _ -> env - end + let push_seff env eff = + let { seff_constant = kn; seff_body = cb } = eff in + let env = Environ.add_constant kn cb env in + match cb.const_universes with + | Polymorphic_const _ -> env + | Monomorphic_const ctx -> + let ctx = match eff.seff_env with + | `Nothing -> ctx + | `Opaque(_, ctx') -> Univ.ContextSet.union ctx' ctx + in + Environ.push_context_set ~strict:true ctx env in let rec translate_seff sl seff acc env = match seff with @@ -527,18 +508,22 @@ let export_side_effects mb env c = | cbs :: rest -> if Int.equal sl 0 then let env, cbs = - List.fold_left (fun (env,cbs) (kn, ocb, u, r) -> + List.fold_left (fun (env,cbs) eff -> + let { seff_constant = kn; seff_body = ocb; seff_env = u } = eff in let ce = constant_entry_of_side_effect ocb u in let cb = translate_constant Pure env kn ce in - (push_seff env (kn, cb,`Nothing, Subproof),(kn,cb,r) :: cbs)) + let eff = { eff with + seff_body = cb; + seff_env = `Nothing; + } in + (push_seff env eff, export_eff eff :: cbs)) (env,[]) cbs in translate_seff 0 rest (cbs @ acc) env else let cbs_len = List.length cbs in let cbs = List.map turn_direct cbs in let env = List.fold_left push_seff env cbs in - let ecbs = List.map (fun (kn,cb,u,r) -> - kn, cb, r) cbs in + let ecbs = List.map export_eff cbs in translate_seff (sl - cbs_len) rest (ecbs @ acc) env in translate_seff trusted seff [] env diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli index 6a0ff072f5..b05e05e4dc 100644 --- a/kernel/term_typing.mli +++ b/kernel/term_typing.mli @@ -38,24 +38,18 @@ val inline_entry_side_effects : yet type checked proof. *) val empty_seff : side_effects -val add_seff : side_effect -> side_effects -> side_effects +val add_seff : Declarations.structure_body -> Entries.side_eff list -> side_effects -> side_effects val concat_seff : side_effects -> side_effects -> side_effects (** [concat_seff e1 e2] adds the side-effects of [e1] to [e2], i.e. effects in [e1] must be more recent than those of [e2]. *) -val uniq_seff : side_effects -> side_effect list +val uniq_seff : side_effects -> side_eff list (** Return the list of individual side-effects in the order of their creation. *) -val equal_eff : side_effect -> side_effect -> bool - val translate_constant : 'a trust -> env -> Constant.t -> 'a constant_entry -> constant_body -type side_effect_role = - | Subproof - | Schema of inductive * string - type exported_side_effect = Constant.t * constant_body * side_effect_role diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml index 1c323e3ea2..60293fe864 100644 --- a/kernel/type_errors.ml +++ b/kernel/type_errors.ml @@ -62,6 +62,7 @@ type ('constr, 'types) ptype_error = | IllTypedRecBody of int * Name.t array * ('constr, 'types) punsafe_judgment array * 'types array | UnsatisfiedConstraints of Univ.Constraint.t + | UndeclaredUniverse of Univ.Level.t type type_error = (constr, types) ptype_error @@ -125,3 +126,6 @@ let error_elim_explain kp ki = let error_unsatisfied_constraints env c = raise (TypeError (env, UnsatisfiedConstraints c)) + +let error_undeclared_universe env l = + raise (TypeError (env, UndeclaredUniverse l)) diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli index 20bf300ac3..9c6ef64b50 100644 --- a/kernel/type_errors.mli +++ b/kernel/type_errors.mli @@ -63,6 +63,7 @@ type ('constr, 'types) ptype_error = | IllTypedRecBody of int * Name.t array * ('constr, 'types) punsafe_judgment array * 'types array | UnsatisfiedConstraints of Univ.Constraint.t + | UndeclaredUniverse of Univ.Level.t type type_error = (constr, types) ptype_error @@ -108,3 +109,5 @@ val error_ill_typed_rec_body : val error_elim_explain : Sorts.family -> Sorts.family -> arity_error val error_unsatisfied_constraints : env -> Univ.Constraint.t -> 'a + +val error_undeclared_universe : env -> Univ.Level.t -> 'a diff --git a/kernel/typeops.ml b/kernel/typeops.ml index 7f36f3813f..25c1cbff3a 100644 --- a/kernel/typeops.ml +++ b/kernel/typeops.ml @@ -431,7 +431,28 @@ and execute_recdef env (names,lar,vdef) i = and execute_array env = Array.map (execute env) (* Derived functions *) + +let universe_levels_of_constr env c = + let rec aux s c = + match kind c with + | Const (c, u) -> + LSet.fold LSet.add (Instance.levels u) s + | Ind ((mind,_), u) | Construct (((mind,_),_), u) -> + LSet.fold LSet.add (Instance.levels u) s + | Sort u when not (Sorts.is_small u) -> + let u = Sorts.univ_of_sort u in + LSet.fold LSet.add (Universe.levels u) s + | _ -> Constr.fold aux s c + in aux LSet.empty c + +let check_wellformed_universes env c = + let univs = universe_levels_of_constr env c in + try UGraph.check_declared_universes (universes env) univs + with UGraph.UndeclaredLevel u -> + error_undeclared_universe env u + let infer env constr = + let () = check_wellformed_universes env constr in let t = execute env constr in make_judge constr t @@ -449,11 +470,13 @@ let type_judgment env {uj_val=c; uj_type=t} = {utj_val = c; utj_type = s } let infer_type env constr = + let () = check_wellformed_universes env constr in let t = execute env constr in let s = check_type env constr t in {utj_val = constr; utj_type = s} let infer_v env cv = + let () = Array.iter (check_wellformed_universes env) cv in let jv = execute_array env cv in make_judgev cv jv @@ -461,9 +484,11 @@ let infer_v env cv = let infer_local_decl env id = function | Entries.LocalDefEntry c -> + let () = check_wellformed_universes env c in let t = execute env c in RelDecl.LocalDef (Name id, c, t) | Entries.LocalAssumEntry c -> + let () = check_wellformed_universes env c in let t = execute env c in RelDecl.LocalAssum (Name id, check_assumption env c t) diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml index bc624ba56d..95d71965df 100644 --- a/kernel/uGraph.ml +++ b/kernel/uGraph.ml @@ -529,6 +529,11 @@ let add_universe vlev strict g = let add_universe_unconstrained vlev g = fst (add_universe_gen vlev g) +exception UndeclaredLevel of Univ.Level.t +let check_declared_universes g us = + let check l = if not (UMap.mem l g.entries) then raise (UndeclaredLevel l) in + Univ.LSet.iter check us + exception Found_explanation of explanation let get_explanation strict u v g = diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli index 8c2d877b0b..752bf76270 100644 --- a/kernel/uGraph.mli +++ b/kernel/uGraph.mli @@ -55,6 +55,12 @@ val add_universe : Level.t -> bool -> t -> t (** Add a universe without (Prop,Set) <= u *) val add_universe_unconstrained : Level.t -> t -> t +(** Check that the universe levels are declared. Otherwise + @raise UndeclaredLevel l for the first undeclared level found. *) +exception UndeclaredLevel of Univ.Level.t + +val check_declared_universes : t -> Univ.LSet.t -> unit + (** {6 Pretty-printing of universes. } *) val pr_universes : (Level.t -> Pp.t) -> t -> Pp.t diff --git a/lib/dune b/lib/dune new file mode 100644 index 0000000000..232c208aa6 --- /dev/null +++ b/lib/dune @@ -0,0 +1,7 @@ +(library + (name lib) + (synopsis "Coq's Utility Library [coq-specific]") + (public_name coq.lib) + (wrapped false) + (modules_without_implementation xml_datatype) + (libraries threads coq.clib coq.config)) diff --git a/library/dune b/library/dune new file mode 100644 index 0000000000..344fad5a75 --- /dev/null +++ b/library/dune @@ -0,0 +1,9 @@ +(library + (name library) + (synopsis "Coq's Loadable Libraries (vo) Support") + (public_name coq.library) + (wrapped false) + (libraries kernel)) + +(documentation + (package coq)) diff --git a/library/global.ml b/library/global.ml index dcb20a280e..e833f71142 100644 --- a/library/global.ml +++ b/library/global.ml @@ -90,6 +90,7 @@ let push_context b c = globalize0 (Safe_typing.push_context b c) let set_engagement c = globalize0 (Safe_typing.set_engagement c) let set_typing_flags c = globalize0 (Safe_typing.set_typing_flags c) +let typing_flags () = Environ.typing_flags (env ()) let export_private_constants ~in_section cd = globalize (Safe_typing.export_private_constants ~in_section cd) let add_constant dir id d = globalize (Safe_typing.add_constant dir (i2l id) d) let add_mind dir id mie = globalize (Safe_typing.add_mind dir (i2l id) mie) @@ -278,3 +279,9 @@ let register_inline c = globalize0 (Safe_typing.register_inline c) let set_strategy k l = GlobalSafeEnv.set_safe_env (Safe_typing.set_strategy (safe_env ()) k l) +let set_reduction_sharing b = + let env = safe_env () in + let flags = Environ.typing_flags (Safe_typing.env_of_safe_env env) in + let flags = { flags with Declarations.share_reduction = b } in + let env = Safe_typing.set_typing_flags flags env in + GlobalSafeEnv.set_safe_env env diff --git a/library/global.mli b/library/global.mli index b2a191ceeb..2819c187ed 100644 --- a/library/global.mli +++ b/library/global.mli @@ -30,6 +30,7 @@ val named_context : unit -> Constr.named_context (** Changing the (im)predicativity of the system *) val set_engagement : Declarations.engagement -> unit val set_typing_flags : Declarations.typing_flags -> unit +val typing_flags : unit -> Declarations.typing_flags (** Variables, Local definitions, constants, inductive types *) @@ -155,6 +156,8 @@ val register_inline : Constant.t -> unit val set_strategy : Constant.t Names.tableKey -> Conv_oracle.level -> unit +val set_reduction_sharing : bool -> unit + (* Modifies the global state, registering new universes *) val current_modpath : unit -> ModPath.t diff --git a/parsing/dune b/parsing/dune new file mode 100644 index 0000000000..b70612a52b --- /dev/null +++ b/parsing/dune @@ -0,0 +1,20 @@ +(library + (name parsing) + (public_name coq.parsing) + (wrapped false) + (libraries proofs)) + +(rule + (targets cLexer.ml) + (deps (:ml4-file cLexer.ml4)) + (action (run camlp5o -loc loc -impl %{ml4-file} -o %{targets}))) + +(rule + (targets g_prim.ml) + (deps (:mlg-file g_prim.mlg)) + (action (run coqpp %{mlg-file}))) + +(rule + (targets g_constr.ml) + (deps (:mlg-file g_constr.mlg)) + (action (run coqpp %{mlg-file}))) diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg index 49e1cd7ec9..7cb5af787b 100644 --- a/parsing/g_constr.mlg +++ b/parsing/g_constr.mlg @@ -249,7 +249,7 @@ GRAMMAR EXTEND Gram record_field_declaration: [ [ id = global; bl = binders; ":="; c = lconstr -> - { (id, mkCLambdaN ~loc bl c) } ] ] + { (id, if bl = [] then c else mkCLambdaN ~loc bl c) } ] ] ; binder_constr: [ [ "forall"; bl = open_binders; ","; c = operconstr LEVEL "200" -> diff --git a/parsing/notgram_ops.ml b/parsing/notgram_ops.ml index c36b3b17bf..5cc1292c92 100644 --- a/parsing/notgram_ops.ml +++ b/parsing/notgram_ops.ml @@ -19,8 +19,10 @@ open Notation_gram let notation_level_map = Summary.ref ~name:"notation_level_map" NotationMap.empty let declare_notation_level ?(onlyprint=false) ntn level = - if NotationMap.mem ntn !notation_level_map then - anomaly (str "Notation " ++ pr_notation ntn ++ str " is already assigned a level."); + try + let (level,onlyprint) = NotationMap.find ntn !notation_level_map in + if not onlyprint then anomaly (str "Notation " ++ pr_notation ntn ++ str " is already assigned a level.") + with Not_found -> notation_level_map := NotationMap.add ntn (level,onlyprint) !notation_level_map let level_of_notation ?(onlyprint=false) ntn = diff --git a/plugins/btauto/plugin_base.dune b/plugins/btauto/plugin_base.dune new file mode 100644 index 0000000000..6a024358c3 --- /dev/null +++ b/plugins/btauto/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name btauto_plugin) + (public_name coq.plugins.btauto) + (synopsis "Coq's btauto plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/cc/plugin_base.dune b/plugins/cc/plugin_base.dune new file mode 100644 index 0000000000..2a92996d2a --- /dev/null +++ b/plugins/cc/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name cc_plugin) + (public_name coq.plugins.cc) + (synopsis "Coq's congruence closure plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/derive/plugin_base.dune b/plugins/derive/plugin_base.dune new file mode 100644 index 0000000000..ba9cd595ce --- /dev/null +++ b/plugins/derive/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name derive_plugin) + (public_name coq.plugins.derive) + (synopsis "Coq's derive plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/extraction/plugin_base.dune b/plugins/extraction/plugin_base.dune new file mode 100644 index 0000000000..037b0d5053 --- /dev/null +++ b/plugins/extraction/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name extraction_plugin) + (public_name coq.plugins.extraction) + (synopsis "Coq's extraction plugin") + (libraries num coq.plugins.ltac)) diff --git a/plugins/firstorder/plugin_base.dune b/plugins/firstorder/plugin_base.dune new file mode 100644 index 0000000000..bcbb99d9fc --- /dev/null +++ b/plugins/firstorder/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name ground_plugin) + (public_name coq.plugins.ground) + (synopsis "Coq's first order logic solver plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/fourier/plugin_base.dune b/plugins/fourier/plugin_base.dune new file mode 100644 index 0000000000..8cc76f6f9e --- /dev/null +++ b/plugins/fourier/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name fourier_plugin) + (public_name coq.plugins.fourier) + (synopsis "Coq's fourier plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/funind/plugin_base.dune b/plugins/funind/plugin_base.dune new file mode 100644 index 0000000000..002eb28eea --- /dev/null +++ b/plugins/funind/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name recdef_plugin) + (public_name coq.plugins.recdef) + (synopsis "Coq's functional induction plugin") + (libraries coq.plugins.extraction)) diff --git a/plugins/ltac/extraargs.ml4 b/plugins/ltac/extraargs.ml4 index dbbdbfa396..d779951180 100644 --- a/plugins/ltac/extraargs.ml4 +++ b/plugins/ltac/extraargs.ml4 @@ -52,8 +52,11 @@ let () = (* Rewriting orientation *) -let _ = Metasyntax.add_token_obj "<-" -let _ = Metasyntax.add_token_obj "->" +let _ = + Mltop.declare_cache_obj + (fun () -> Metasyntax.add_token_obj "<-"; + Metasyntax.add_token_obj "->") + "ltac_plugin" let pr_orient _prc _prlc _prt = function | true -> Pp.mt () diff --git a/plugins/ltac/plugin_base.dune b/plugins/ltac/plugin_base.dune new file mode 100644 index 0000000000..5611f5ba16 --- /dev/null +++ b/plugins/ltac/plugin_base.dune @@ -0,0 +1,13 @@ +(library + (name ltac_plugin) + (public_name coq.plugins.ltac) + (synopsis "Coq's LTAC tactic language") + (modules :standard \ tauto) + (libraries coq.stm)) + +(library + (name tauto_plugin) + (public_name coq.plugins.tauto) + (synopsis "Coq's tauto tactic") + (modules tauto) + (libraries coq.plugins.ltac)) diff --git a/plugins/ltac/tacenv.ml b/plugins/ltac/tacenv.ml index 0bb9ccb1d8..1f2c722b34 100644 --- a/plugins/ltac/tacenv.ml +++ b/plugins/ltac/tacenv.ml @@ -144,7 +144,7 @@ let add ~deprecation kn b t = mactab := KNmap.add kn entry !mactab let replace kn path t = - let (path, _, _) = KerName.repr path in + let path = KerName.modpath path in let entry _ e = { e with tac_body = t; tac_redef = path :: e.tac_redef } in mactab := KNmap.modify kn entry !mactab diff --git a/plugins/micromega/plugin_base.dune b/plugins/micromega/plugin_base.dune new file mode 100644 index 0000000000..0ae0e6855d --- /dev/null +++ b/plugins/micromega/plugin_base.dune @@ -0,0 +1,7 @@ +(library + (name micromega_plugin) + (public_name coq.plugins.micromega) + ; be careful not to link the executable to the plugin! + (modules (:standard \ csdpcert)) + (synopsis "Coq's micromega plugin") + (libraries num coq.plugins.ltac)) diff --git a/plugins/nsatz/plugin_base.dune b/plugins/nsatz/plugin_base.dune new file mode 100644 index 0000000000..9da5b39972 --- /dev/null +++ b/plugins/nsatz/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name nsatz_plugin) + (public_name coq.plugins.nsatz) + (synopsis "Coq's nsatz solver plugin") + (libraries num coq.plugins.ltac)) diff --git a/plugins/omega/plugin_base.dune b/plugins/omega/plugin_base.dune new file mode 100644 index 0000000000..f512501c78 --- /dev/null +++ b/plugins/omega/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name omega_plugin) + (public_name coq.plugins.omega) + (synopsis "Coq's omega plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/quote/plugin_base.dune b/plugins/quote/plugin_base.dune new file mode 100644 index 0000000000..323906acb2 --- /dev/null +++ b/plugins/quote/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name quote_plugin) + (public_name coq.plugins.quote) + (synopsis "Coq's quote plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/romega/plugin_base.dune b/plugins/romega/plugin_base.dune new file mode 100644 index 0000000000..49b0e10edf --- /dev/null +++ b/plugins/romega/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name romega_plugin) + (public_name coq.plugins.romega) + (synopsis "Coq's romega plugin") + (libraries coq.plugins.omega)) diff --git a/plugins/rtauto/plugin_base.dune b/plugins/rtauto/plugin_base.dune new file mode 100644 index 0000000000..233845ae0f --- /dev/null +++ b/plugins/rtauto/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name rtauto_plugin) + (public_name coq.plugins.rtauto) + (synopsis "Coq's rtauto plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/setoid_ring/plugin_base.dune b/plugins/setoid_ring/plugin_base.dune new file mode 100644 index 0000000000..101246e28f --- /dev/null +++ b/plugins/setoid_ring/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name newring_plugin) + (public_name coq.plugins.setoid_ring) + (synopsis "Coq's setoid ring plugin") + (libraries coq.plugins.quote)) diff --git a/plugins/ssr/plugin_base.dune b/plugins/ssr/plugin_base.dune new file mode 100644 index 0000000000..de9053f1a0 --- /dev/null +++ b/plugins/ssr/plugin_base.dune @@ -0,0 +1,6 @@ +(library + (name ssreflect_plugin) + (public_name coq.plugins.ssreflect) + (synopsis "Coq's ssreflect plugin") + (modules_without_implementation ssrast) + (libraries coq.plugins.ssrmatching)) diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml index 46fde41150..1dbacf0ff7 100644 --- a/plugins/ssr/ssripats.ml +++ b/plugins/ssr/ssripats.ml @@ -379,8 +379,9 @@ let elim_intro_tac ipats ?ist what eqid ssrelim is_rec clr = let ctx, last = EConstr.decompose_prod_assum sigma concl in let args = match EConstr.kind_of_type sigma last with | Term.AtomicType (hd, args) -> - assert(Ssrcommon.is_protect hd env sigma); - args + if Ssrcommon.is_protect hd env sigma then args + else Ssrcommon.errorstrm + (Pp.str "Too many names in intro pattern") | _ -> assert false in let case = args.(Array.length args-1) in if not(EConstr.Vars.closed0 sigma case) diff --git a/plugins/ssrmatching/plugin_base.dune b/plugins/ssrmatching/plugin_base.dune new file mode 100644 index 0000000000..06f67c3774 --- /dev/null +++ b/plugins/ssrmatching/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name ssrmatching_plugin) + (public_name coq.plugins.ssrmatching) + (synopsis "Coq ssrmatching plugin") + (libraries coq.plugins.ltac)) diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml index 47a59ba631..5e36fbeb81 100644 --- a/plugins/syntax/ascii_syntax.ml +++ b/plugins/syntax/ascii_syntax.ml @@ -83,8 +83,18 @@ let make_ascii_string n = let uninterp_ascii_string (AnyGlobConstr r) = Option.map make_ascii_string (uninterp_ascii r) +open Notation + +let at_declare_ml_module f x = + Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name + let _ = - Notation.declare_string_interpreter "char_scope" - (ascii_path,ascii_module) - interp_ascii_string - ([DAst.make @@ GRef (static_glob_Ascii,None)], uninterp_ascii_string, true) + let sc = "char_scope" in + register_string_interpretation sc (interp_ascii_string,uninterp_ascii_string); + at_declare_ml_module enable_prim_token_interpretation + { pt_local = false; + pt_scope = sc; + pt_uid = sc; + pt_required = (ascii_path,ascii_module); + pt_refs = [static_glob_Ascii]; + pt_in_match = true } diff --git a/plugins/syntax/g_numeral.ml4 b/plugins/syntax/g_numeral.ml4 new file mode 100644 index 0000000000..ec14df3baa --- /dev/null +++ b/plugins/syntax/g_numeral.ml4 @@ -0,0 +1,37 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +DECLARE PLUGIN "numeral_notation_plugin" + +open Numeral +open Pp +open Names +open Vernacinterp +open Ltac_plugin +open Stdarg +open Pcoq.Prim + +let pr_numnot_option _ _ _ = function + | Nop -> mt () + | Warning n -> str "(warning after " ++ str n ++ str ")" + | Abstract n -> str "(abstract after " ++ str n ++ str ")" + +ARGUMENT EXTEND numnotoption + PRINTED BY pr_numnot_option +| [ ] -> [ Nop ] +| [ "(" "warning" "after" bigint(waft) ")" ] -> [ Warning waft ] +| [ "(" "abstract" "after" bigint(n) ")" ] -> [ Abstract n ] +END + +VERNAC COMMAND EXTEND NumeralNotation CLASSIFIED AS SIDEFF + | [ "Numeral" "Notation" reference(ty) reference(f) reference(g) ":" + ident(sc) numnotoption(o) ] -> + [ vernac_numeral_notation (Locality.make_module_locality atts.locality) ty f g (Id.to_string sc) o ] +END diff --git a/plugins/syntax/int31_syntax.ml b/plugins/syntax/int31_syntax.ml index f10f98e23b..d3ffe936a9 100644 --- a/plugins/syntax/int31_syntax.ml +++ b/plugins/syntax/int31_syntax.ml @@ -96,10 +96,19 @@ let uninterp_int31 (AnyGlobConstr i) = with Non_closed -> None +open Notation + +let at_declare_ml_module f x = + Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name + (* Actually declares the interpreter for int31 *) -let _ = Notation.declare_numeral_interpreter int31_scope - (int31_path, int31_module) - interp_int31 - ([DAst.make (GRef (int31_construct, None))], - uninterp_int31, - true) + +let _ = + register_bignumeral_interpretation int31_scope (interp_int31,uninterp_int31); + at_declare_ml_module enable_prim_token_interpretation + { pt_local = false; + pt_scope = int31_scope; + pt_uid = int31_scope; + pt_required = (int31_path,int31_module); + pt_refs = [int31_construct]; + pt_in_match = true } diff --git a/plugins/syntax/n_syntax.ml b/plugins/syntax/n_syntax.ml deleted file mode 100644 index 0e202be47f..0000000000 --- a/plugins/syntax/n_syntax.ml +++ /dev/null @@ -1,81 +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) *) -(************************************************************************) - -open Pp -open CErrors -open Names -open Bigint -open Positive_syntax_plugin.Positive_syntax - -(* Poor's man DECLARE PLUGIN *) -let __coq_plugin_name = "n_syntax_plugin" -let () = Mltop.add_known_module __coq_plugin_name - -(**********************************************************************) -(* Parsing N via scopes *) -(**********************************************************************) - -open Globnames -open Glob_term - -let binnums = ["Coq";"Numbers";"BinNums"] - -let make_dir l = DirPath.make (List.rev_map Id.of_string l) -let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id) - -(* TODO: temporary hack *) -let make_kn dir id = Globnames.encode_mind dir id - -let n_kn = make_kn (make_dir binnums) (Id.of_string "N") -let glob_n = IndRef (n_kn,0) -let path_of_N0 = ((n_kn,0),1) -let path_of_Npos = ((n_kn,0),2) -let glob_N0 = ConstructRef path_of_N0 -let glob_Npos = ConstructRef path_of_Npos - -let n_path = make_path binnums "N" - -let n_of_binnat ?loc pos_or_neg n = DAst.make ?loc @@ - if not (Bigint.equal n zero) then - GApp(DAst.make @@ GRef (glob_Npos,None), [pos_of_bignat ?loc n]) - else - GRef(glob_N0, None) - -let error_negative ?loc = - user_err ?loc ~hdr:"interp_N" (str "No negative numbers in type \"N\".") - -let n_of_int ?loc n = - if is_pos_or_zero n then n_of_binnat ?loc true n - else error_negative ?loc - -(**********************************************************************) -(* Printing N via scopes *) -(**********************************************************************) - -let bignat_of_n n = DAst.with_val (function - | GApp (r, [a]) when is_gr r glob_Npos -> bignat_of_pos a - | GRef (a,_) when GlobRef.equal a glob_N0 -> Bigint.zero - | _ -> raise Non_closed_number - ) n - -let uninterp_n (AnyGlobConstr p) = - try Some (bignat_of_n p) - with Non_closed_number -> None - -(************************************************************************) -(* Declaring interpreters and uninterpreters for N *) - -let _ = Notation.declare_numeral_interpreter "N_scope" - (n_path,binnums) - n_of_int - ([DAst.make @@ GRef (glob_N0, None); - DAst.make @@ GRef (glob_Npos, None)], - uninterp_n, - true) diff --git a/plugins/syntax/n_syntax_plugin.mlpack b/plugins/syntax/n_syntax_plugin.mlpack deleted file mode 100644 index 4c56645f07..0000000000 --- a/plugins/syntax/n_syntax_plugin.mlpack +++ /dev/null @@ -1 +0,0 @@ -N_syntax diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml deleted file mode 100644 index e158e0b516..0000000000 --- a/plugins/syntax/nat_syntax.ml +++ /dev/null @@ -1,85 +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) *) -(************************************************************************) - - -(* Poor's man DECLARE PLUGIN *) -let __coq_plugin_name = "nat_syntax_plugin" -let () = Mltop.add_known_module __coq_plugin_name - -(* This file defines the printer for natural numbers in [nat] *) - -(*i*) -open Pp -open CErrors -open Names -open Glob_term -open Bigint -open Coqlib -(*i*) - -(**********************************************************************) -(* Parsing via scopes *) -(* For example, (nat_of_string "3") is <<(S (S (S O)))>> *) - -let threshold = of_int 5000 - -let warn_large_nat = - CWarnings.create ~name:"large-nat" ~category:"numbers" - (fun () -> strbrk "Stack overflow or segmentation fault happens when " ++ - strbrk "working with large numbers in nat (observed threshold " ++ - strbrk "may vary from 5000 to 70000 depending on your system " ++ - strbrk "limits and on the command executed).") - -let nat_of_int ?loc n = - if is_pos_or_zero n then begin - if less_than threshold n then warn_large_nat (); - let ref_O = DAst.make ?loc @@ GRef (glob_O, None) in - let ref_S = DAst.make ?loc @@ GRef (glob_S, None) in - let rec mk_nat acc n = - if n <> zero then - mk_nat (DAst.make ?loc @@ GApp (ref_S, [acc])) (sub_1 n) - else - acc - in - mk_nat ref_O n - end - else - user_err ?loc ~hdr:"nat_of_int" - (str "Cannot interpret a negative number as a number of type nat") - -(************************************************************************) -(* Printing via scopes *) - -exception Non_closed_number - -let rec int_of_nat x = DAst.with_val (function - | GApp (r, [a]) -> - begin match DAst.get r with - | GRef (s,_) when GlobRef.equal s glob_S -> add_1 (int_of_nat a) - | _ -> raise Non_closed_number - end - | GRef (z,_) when GlobRef.equal z glob_O -> zero - | _ -> raise Non_closed_number - ) x - -let uninterp_nat (AnyGlobConstr p) = - try - Some (int_of_nat p) - with - Non_closed_number -> None - -(************************************************************************) -(* Declare the primitive parsers and printers *) - -let _ = - Notation.declare_numeral_interpreter "nat_scope" - (nat_path,datatypes_module_name) - nat_of_int - ([DAst.make @@ GRef (glob_S,None); DAst.make @@ GRef (glob_O,None)], uninterp_nat, true) diff --git a/plugins/syntax/nat_syntax_plugin.mlpack b/plugins/syntax/nat_syntax_plugin.mlpack deleted file mode 100644 index 39bdd62f47..0000000000 --- a/plugins/syntax/nat_syntax_plugin.mlpack +++ /dev/null @@ -1 +0,0 @@ -Nat_syntax diff --git a/plugins/syntax/numeral.ml b/plugins/syntax/numeral.ml new file mode 100644 index 0000000000..fee93593d0 --- /dev/null +++ b/plugins/syntax/numeral.ml @@ -0,0 +1,478 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +open Pp +open Util +open Names +open Libnames +open Globnames +open Constrexpr +open Constrexpr_ops +open Constr + +(** * Numeral notation *) + +(** Reduction + + The constr [c] below isn't necessarily well-typed, since we + built it via an [mkApp] of a conversion function on a term + that starts with the right constructor but might be partially + applied. + + At least [c] is known to be evar-free, since it comes from + our own ad-hoc [constr_of_glob] or from conversions such + as [coqint_of_rawnum]. +*) + +let eval_constr env sigma (c : Constr.t) = + let c = EConstr.of_constr c in + let sigma,t = Typing.type_of env sigma c in + let c' = Vnorm.cbv_vm env sigma c t in + EConstr.Unsafe.to_constr c' + +(* For testing with "compute" instead of "vm_compute" : +let eval_constr env sigma (c : Constr.t) = + let c = EConstr.of_constr c in + let c' = Tacred.compute env sigma c in + EConstr.Unsafe.to_constr c' +*) + +let eval_constr_app env sigma c1 c2 = + eval_constr env sigma (mkApp (c1,[| c2 |])) + +exception NotANumber + +let warn_large_num = + CWarnings.create ~name:"large-number" ~category:"numbers" + (fun ty -> + strbrk "Stack overflow or segmentation fault happens when " ++ + strbrk "working with large numbers in " ++ pr_qualid ty ++ + strbrk " (threshold may vary depending" ++ + strbrk " on your system limits and on the command executed).") + +let warn_abstract_large_num = + CWarnings.create ~name:"abstract-large-number" ~category:"numbers" + (fun (ty,f) -> + strbrk "To avoid stack overflow, large numbers in " ++ + pr_qualid ty ++ strbrk " are interpreted as applications of " ++ + Printer.pr_global_env (Termops.vars_of_env (Global.env ())) f ++ strbrk ".") + +let warn_abstract_large_num_no_op = + CWarnings.create ~name:"abstract-large-number-no-op" ~category:"numbers" + (fun f -> + strbrk "The 'abstract after' directive has no effect when " ++ + strbrk "the parsing function (" ++ + Printer.pr_global_env (Termops.vars_of_env (Global.env ())) f ++ strbrk ") targets an " ++ + strbrk "option type.") + +(** Comparing two raw numbers (base 10, big-endian, non-negative). + A bit nasty, but not critical: only used to decide when a + number is considered as large (see warnings above). *) + +exception Comp of int + +let rec rawnum_compare s s' = + let l = String.length s and l' = String.length s' in + if l < l' then - rawnum_compare s' s + else + let d = l-l' in + try + for i = 0 to d-1 do if s.[i] != '0' then raise (Comp 1) done; + for i = d to l-1 do + let c = Pervasives.compare s.[i] s'.[i-d] in + if c != 0 then raise (Comp c) + done; + 0 + with Comp c -> c + +(***********************************************************************) + +(** ** Conversion between Coq [Decimal.int] and internal raw string *) + +type int_ty = + { uint : Names.inductive; + int : Names.inductive } + +(** Decimal.Nil has index 1, then Decimal.D0 has index 2 .. Decimal.D9 is 11 *) + +let digit_of_char c = + assert ('0' <= c && c <= '9'); + Char.code c - Char.code '0' + 2 + +let char_of_digit n = + assert (2<=n && n<=11); + Char.chr (n-2 + Char.code '0') + +let coquint_of_rawnum uint str = + let nil = mkConstruct (uint,1) in + let rec do_chars s i acc = + if i < 0 then acc + else + let dg = mkConstruct (uint, digit_of_char s.[i]) in + do_chars s (i-1) (mkApp(dg,[|acc|])) + in + do_chars str (String.length str - 1) nil + +let coqint_of_rawnum inds (str,sign) = + let uint = coquint_of_rawnum inds.uint str in + mkApp (mkConstruct (inds.int, if sign then 1 else 2), [|uint|]) + +let rawnum_of_coquint c = + let rec of_uint_loop c buf = + match Constr.kind c with + | Construct ((_,1), _) (* Nil *) -> () + | App (c, [|a|]) -> + (match Constr.kind c with + | Construct ((_,n), _) (* D0 to D9 *) -> + let () = Buffer.add_char buf (char_of_digit n) in + of_uint_loop a buf + | _ -> raise NotANumber) + | _ -> raise NotANumber + in + let buf = Buffer.create 64 in + let () = of_uint_loop c buf in + if Int.equal (Buffer.length buf) 0 then + (* To avoid ambiguities between Nil and (D0 Nil), we choose + to not display Nil alone as "0" *) + raise NotANumber + else Buffer.contents buf + +let rawnum_of_coqint c = + match Constr.kind c with + | App (c,[|c'|]) -> + (match Constr.kind c with + | Construct ((_,1), _) (* Pos *) -> (rawnum_of_coquint c', true) + | Construct ((_,2), _) (* Neg *) -> (rawnum_of_coquint c', false) + | _ -> raise NotANumber) + | _ -> raise NotANumber + + +(***********************************************************************) + +(** ** Conversion between Coq [Z] and internal bigint *) + +type z_pos_ty = + { z_ty : Names.inductive; + pos_ty : Names.inductive } + +(** First, [positive] from/to bigint *) + +let rec pos_of_bigint posty n = + match Bigint.div2_with_rest n with + | (q, false) -> + let c = mkConstruct (posty, 2) in (* xO *) + mkApp (c, [| pos_of_bigint posty q |]) + | (q, true) when not (Bigint.equal q Bigint.zero) -> + let c = mkConstruct (posty, 1) in (* xI *) + mkApp (c, [| pos_of_bigint posty q |]) + | (q, true) -> + mkConstruct (posty, 3) (* xH *) + +let rec bigint_of_pos c = match Constr.kind c with + | Construct ((_, 3), _) -> (* xH *) Bigint.one + | App (c, [| d |]) -> + begin match Constr.kind c with + | Construct ((_, n), _) -> + begin match n with + | 1 -> (* xI *) Bigint.add_1 (Bigint.mult_2 (bigint_of_pos d)) + | 2 -> (* xO *) Bigint.mult_2 (bigint_of_pos d) + | n -> assert false (* no other constructor of type positive *) + end + | x -> raise NotANumber + end + | x -> raise NotANumber + +(** Now, [Z] from/to bigint *) + +let z_of_bigint { z_ty; pos_ty } n = + if Bigint.equal n Bigint.zero then + mkConstruct (z_ty, 1) (* Z0 *) + else + let (s, n) = + if Bigint.is_pos_or_zero n then (2, n) (* Zpos *) + else (3, Bigint.neg n) (* Zneg *) + in + let c = mkConstruct (z_ty, s) in + mkApp (c, [| pos_of_bigint pos_ty n |]) + +let bigint_of_z z = match Constr.kind z with + | Construct ((_, 1), _) -> (* Z0 *) Bigint.zero + | App (c, [| d |]) -> + begin match Constr.kind c with + | Construct ((_, n), _) -> + begin match n with + | 2 -> (* Zpos *) bigint_of_pos d + | 3 -> (* Zneg *) Bigint.neg (bigint_of_pos d) + | n -> assert false (* no other constructor of type Z *) + end + | _ -> raise NotANumber + end + | _ -> raise NotANumber + +(** The uninterp function below work at the level of [glob_constr] + which is too low for us here. So here's a crude conversion back + to [constr] for the subset that concerns us. *) + +let rec constr_of_glob env sigma g = match DAst.get g with + | Glob_term.GRef (ConstructRef c, _) -> + let sigma,c = Evd.fresh_constructor_instance env sigma c in + sigma,mkConstructU c + | Glob_term.GApp (gc, gcl) -> + let sigma,c = constr_of_glob env sigma gc in + let sigma,cl = List.fold_left_map (constr_of_glob env) sigma gcl in + sigma,mkApp (c, Array.of_list cl) + | _ -> + raise NotANumber + +let rec glob_of_constr ?loc c = match Constr.kind c with + | App (c, ca) -> + let c = glob_of_constr ?loc c in + let cel = List.map (glob_of_constr ?loc) (Array.to_list ca) in + DAst.make ?loc (Glob_term.GApp (c, cel)) + | Construct (c, _) -> DAst.make ?loc (Glob_term.GRef (ConstructRef c, None)) + | Const (c, _) -> DAst.make ?loc (Glob_term.GRef (ConstRef c, None)) + | Ind (ind, _) -> DAst.make ?loc (Glob_term.GRef (IndRef ind, None)) + | Var id -> DAst.make ?loc (Glob_term.GRef (VarRef id, None)) + | _ -> let (sigma, env) = Pfedit.get_current_context () in + CErrors.user_err ?loc + (strbrk "Unexpected term " ++ + Printer.pr_constr_env env sigma c ++ + strbrk " while parsing a numeral notation.") + +let no_such_number ?loc ty = + CErrors.user_err ?loc + (str "Cannot interpret this number as a value of type " ++ + pr_qualid ty) + +let interp_option ty ?loc c = + match Constr.kind c with + | App (_Some, [| _; c |]) -> glob_of_constr ?loc c + | App (_None, [| _ |]) -> no_such_number ?loc ty + | x -> let (sigma, env) = Pfedit.get_current_context () in + CErrors.user_err ?loc + (strbrk "Unexpected non-option term " ++ + Printer.pr_constr_env env sigma c ++ + strbrk " while parsing a numeral notation.") + +let uninterp_option c = + match Constr.kind c with + | App (_Some, [| _; x |]) -> x + | _ -> raise NotANumber + +let big2raw n = + if Bigint.is_pos_or_zero n then (Bigint.to_string n, true) + else (Bigint.to_string (Bigint.neg n), false) + +let raw2big (n,s) = + if s then Bigint.of_string n else Bigint.neg (Bigint.of_string n) + +type target_kind = + | Int of int_ty (* Coq.Init.Decimal.int + uint *) + | UInt of Names.inductive (* Coq.Init.Decimal.uint *) + | Z of z_pos_ty (* Coq.Numbers.BinNums.Z and positive *) + +type option_kind = Option | Direct +type conversion_kind = target_kind * option_kind + +type numnot_option = + | Nop + | Warning of raw_natural_number + | Abstract of raw_natural_number + +type numeral_notation_obj = + { to_kind : conversion_kind; + to_ty : GlobRef.t; + of_kind : conversion_kind; + of_ty : GlobRef.t; + num_ty : Libnames.qualid; (* for warnings / error messages *) + warning : numnot_option } + +let interp o ?loc n = + begin match o.warning with + | Warning threshold when snd n && rawnum_compare (fst n) threshold >= 0 -> + warn_large_num o.num_ty + | _ -> () + end; + let c = match fst o.to_kind with + | Int int_ty -> coqint_of_rawnum int_ty n + | UInt uint_ty when snd n -> coquint_of_rawnum uint_ty (fst n) + | UInt _ (* n <= 0 *) -> no_such_number ?loc o.num_ty + | Z z_pos_ty -> z_of_bigint z_pos_ty (raw2big n) + in + let env = Global.env () in + let sigma = Evd.from_env env in + let sigma,to_ty = Evd.fresh_global env sigma o.to_ty in + let to_ty = EConstr.Unsafe.to_constr to_ty in + match o.warning, snd o.to_kind with + | Abstract threshold, Direct when rawnum_compare (fst n) threshold >= 0 -> + warn_abstract_large_num (o.num_ty,o.to_ty); + glob_of_constr ?loc (mkApp (to_ty,[|c|])) + | _ -> + let res = eval_constr_app env sigma to_ty c in + match snd o.to_kind with + | Direct -> glob_of_constr ?loc res + | Option -> interp_option o.num_ty ?loc res + +let uninterp o (Glob_term.AnyGlobConstr n) = + let env = Global.env () in + let sigma = Evd.from_env env in + let sigma,of_ty = Evd.fresh_global env sigma o.of_ty in + let of_ty = EConstr.Unsafe.to_constr of_ty in + try + let sigma,n = constr_of_glob env sigma n in + let c = eval_constr_app env sigma of_ty n in + let c = if snd o.of_kind == Direct then c else uninterp_option c in + match fst o.of_kind with + | Int _ -> Some (rawnum_of_coqint c) + | UInt _ -> Some (rawnum_of_coquint c, true) + | Z _ -> Some (big2raw (bigint_of_z c)) + with + | Type_errors.TypeError _ | Pretype_errors.PretypeError _ -> None (* cf. eval_constr_app *) + | NotANumber -> None (* all other functions except big2raw *) + +(* Here we only register the interp and uninterp functions + for a particular Numeral Notation (determined by a unique + string). The actual activation of the notation will be done + later (cf. Notation.enable_prim_token_interpretation). + This registration of interp/uninterp must be added in the + libstack, otherwise this won't work through a Require. *) + +let load_numeral_notation _ (_, (uid,opts)) = + Notation.register_rawnumeral_interpretation + ~allow_overwrite:true uid (interp opts, uninterp opts) + +let cache_numeral_notation x = load_numeral_notation 1 x + +(* TODO: substitution ? + TODO: uid pas stable par substitution dans opts + *) + +let inNumeralNotation : string * numeral_notation_obj -> Libobject.obj = + Libobject.declare_object { + (Libobject.default_object "NUMERAL NOTATION") with + Libobject.cache_function = cache_numeral_notation; + Libobject.load_function = load_numeral_notation } + +let get_constructors ind = + let mib,oib = Global.lookup_inductive ind in + let mc = oib.Declarations.mind_consnames in + Array.to_list + (Array.mapi (fun j c -> ConstructRef (ind, j + 1)) mc) + +let q_z = qualid_of_string "Coq.Numbers.BinNums.Z" +let q_positive = qualid_of_string "Coq.Numbers.BinNums.positive" +let q_int = qualid_of_string "Coq.Init.Decimal.int" +let q_uint = qualid_of_string "Coq.Init.Decimal.uint" +let q_option = qualid_of_string "Coq.Init.Datatypes.option" + +let unsafe_locate_ind q = + match Nametab.locate q with + | IndRef i -> i + | _ -> raise Not_found + +let locate_ind q = + try unsafe_locate_ind q + with Not_found -> Nametab.error_global_not_found q + +let locate_z () = + try + Some { z_ty = unsafe_locate_ind q_z; + pos_ty = unsafe_locate_ind q_positive } + with Not_found -> None + +let locate_int () = + { uint = locate_ind q_uint; + int = locate_ind q_int } + +let has_type f ty = + let (sigma, env) = Pfedit.get_current_context () in + let c = mkCastC (mkRefC f, Glob_term.CastConv ty) in + try let _ = Constrintern.interp_constr env sigma c in true + with Pretype_errors.PretypeError _ -> false + +let type_error_to f ty loadZ = + CErrors.user_err + (pr_qualid f ++ str " should go from Decimal.int to " ++ + pr_qualid ty ++ str " or (option " ++ pr_qualid ty ++ str ")." ++ + fnl () ++ str "Instead of Decimal.int, the types Decimal.uint or Z could be used" ++ + (if loadZ then str " (require BinNums first)." else str ".")) + +let type_error_of g ty loadZ = + CErrors.user_err + (pr_qualid g ++ str " should go from " ++ pr_qualid ty ++ + str " to Decimal.int or (option Decimal.int)." ++ fnl () ++ + str "Instead of Decimal.int, the types Decimal.uint or Z could be used" ++ + (if loadZ then str " (require BinNums first)." else str ".")) + +let vernac_numeral_notation local ty f g scope opts = + let int_ty = locate_int () in + let z_pos_ty = locate_z () in + let tyc = Smartlocate.global_inductive_with_alias ty in + let to_ty = Smartlocate.global_with_alias f in + let of_ty = Smartlocate.global_with_alias g in + let cty = mkRefC ty in + let app x y = mkAppC (x,[y]) in + let cref q = mkRefC q in + let arrow x y = + mkProdC ([CAst.make Anonymous],Default Decl_kinds.Explicit, x, y) + in + let cZ = cref q_z in + let cint = cref q_int in + let cuint = cref q_uint in + let coption = cref q_option in + let opt r = app coption r in + let constructors = get_constructors tyc in + (* Check the type of f *) + let to_kind = + if has_type f (arrow cint cty) then Int int_ty, Direct + else if has_type f (arrow cint (opt cty)) then Int int_ty, Option + else if has_type f (arrow cuint cty) then UInt int_ty.uint, Direct + else if has_type f (arrow cuint (opt cty)) then UInt int_ty.uint, Option + else + match z_pos_ty with + | Some z_pos_ty -> + if has_type f (arrow cZ cty) then Z z_pos_ty, Direct + else if has_type f (arrow cZ (opt cty)) then Z z_pos_ty, Option + else type_error_to f ty false + | None -> type_error_to f ty true + in + (* Check the type of g *) + let of_kind = + if has_type g (arrow cty cint) then Int int_ty, Direct + else if has_type g (arrow cty (opt cint)) then Int int_ty, Option + else if has_type g (arrow cty cuint) then UInt int_ty.uint, Direct + else if has_type g (arrow cty (opt cuint)) then UInt int_ty.uint, Option + else + match z_pos_ty with + | Some z_pos_ty -> + if has_type g (arrow cty cZ) then Z z_pos_ty, Direct + else if has_type g (arrow cty (opt cZ)) then Z z_pos_ty, Option + else type_error_of g ty false + | None -> type_error_of g ty true + in + let o = { to_kind; to_ty; of_kind; of_ty; + num_ty = ty; + warning = opts } + in + (match opts, to_kind with + | Abstract _, (_, Option) -> warn_abstract_large_num_no_op o.to_ty + | _ -> ()); + (* TODO: un hash suffit-il ? *) + let uid = Marshal.to_string o [] in + let i = Notation.( + { pt_local = local; + pt_scope = scope; + pt_uid = uid; + pt_required = Nametab.path_of_global (IndRef tyc),[]; + pt_refs = constructors; + pt_in_match = true }) + in + Lib.add_anonymous_leaf (inNumeralNotation (uid,o)); + Notation.enable_prim_token_interpretation i diff --git a/plugins/syntax/numeral.mli b/plugins/syntax/numeral.mli new file mode 100644 index 0000000000..83ede6f48f --- /dev/null +++ b/plugins/syntax/numeral.mli @@ -0,0 +1,22 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +open Libnames +open Constrexpr +open Vernacexpr + +(** * Numeral notation *) + +type numnot_option = + | Nop + | Warning of raw_natural_number + | Abstract of raw_natural_number + +val vernac_numeral_notation : locality_flag -> qualid -> qualid -> qualid -> Notation_term.scope_name -> numnot_option -> unit diff --git a/plugins/syntax/numeral_notation_plugin.mlpack b/plugins/syntax/numeral_notation_plugin.mlpack new file mode 100644 index 0000000000..f4d9cae3ff --- /dev/null +++ b/plugins/syntax/numeral_notation_plugin.mlpack @@ -0,0 +1,2 @@ +Numeral +G_numeral diff --git a/plugins/syntax/plugin_base.dune b/plugins/syntax/plugin_base.dune new file mode 100644 index 0000000000..bfdd480fe9 --- /dev/null +++ b/plugins/syntax/plugin_base.dune @@ -0,0 +1,35 @@ +(library + (name numeral_notation_plugin) + (public_name coq.plugins.numeral_notation) + (synopsis "Coq numeral notation plugin") + (modules g_numeral numeral) + (libraries coq.plugins.ltac)) + +(library + (name r_syntax_plugin) + (public_name coq.plugins.r_syntax) + (synopsis "Coq syntax plugin: reals") + (modules r_syntax) + (libraries coq.vernac)) + +(library + (name ascii_syntax_plugin) + (public_name coq.plugins.ascii_syntax) + (synopsis "Coq syntax plugin: ASCII") + (modules ascii_syntax) + (libraries coq.vernac)) + +(library + (name string_syntax_plugin) + (public_name coq.plugins.string_syntax) + (synopsis "Coq syntax plugin: strings") + (modules string_syntax) + (libraries coq.plugins.ascii_syntax)) + +(library + (name int31_syntax_plugin) + (public_name coq.plugins.int31_syntax) + (synopsis "Coq syntax plugin: int31") + (modules int31_syntax) + (libraries coq.vernac)) + diff --git a/plugins/syntax/positive_syntax.ml b/plugins/syntax/positive_syntax.ml deleted file mode 100644 index 0c82e47445..0000000000 --- a/plugins/syntax/positive_syntax.ml +++ /dev/null @@ -1,101 +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) *) -(************************************************************************) - -open Pp -open CErrors -open Util -open Names -open Bigint - -(* Poor's man DECLARE PLUGIN *) -let __coq_plugin_name = "positive_syntax_plugin" -let () = Mltop.add_known_module __coq_plugin_name - -exception Non_closed_number - -(**********************************************************************) -(* Parsing positive via scopes *) -(**********************************************************************) - -open Globnames -open Glob_term - -let binnums = ["Coq";"Numbers";"BinNums"] - -let make_dir l = DirPath.make (List.rev_map Id.of_string l) -let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id) - -let positive_path = make_path binnums "positive" - -(* TODO: temporary hack *) -let make_kn dir id = Globnames.encode_mind dir id - -let positive_kn = make_kn (make_dir binnums) (Id.of_string "positive") -let glob_positive = IndRef (positive_kn,0) -let path_of_xI = ((positive_kn,0),1) -let path_of_xO = ((positive_kn,0),2) -let path_of_xH = ((positive_kn,0),3) -let glob_xI = ConstructRef path_of_xI -let glob_xO = ConstructRef path_of_xO -let glob_xH = ConstructRef path_of_xH - -let pos_of_bignat ?loc x = - let ref_xI = DAst.make ?loc @@ GRef (glob_xI, None) in - let ref_xH = DAst.make ?loc @@ GRef (glob_xH, None) in - let ref_xO = DAst.make ?loc @@ GRef (glob_xO, None) in - let rec pos_of x = - match div2_with_rest x with - | (q,false) -> DAst.make ?loc @@ GApp (ref_xO,[pos_of q]) - | (q,true) when not (Bigint.equal q zero) -> DAst.make ?loc @@ GApp (ref_xI,[pos_of q]) - | (q,true) -> ref_xH - in - pos_of x - -let error_non_positive ?loc = - user_err ?loc ~hdr:"interp_positive" - (str "Only strictly positive numbers in type \"positive\".") - -let interp_positive ?loc n = - if is_strictly_pos n then pos_of_bignat ?loc n - else error_non_positive ?loc - -(**********************************************************************) -(* Printing positive via scopes *) -(**********************************************************************) - -let is_gr c gr = match DAst.get c with -| GRef (r, _) -> GlobRef.equal r gr -| _ -> false - -let rec bignat_of_pos x = DAst.with_val (function - | GApp (r ,[a]) when is_gr r glob_xO -> mult_2(bignat_of_pos a) - | GApp (r ,[a]) when is_gr r glob_xI -> add_1(mult_2(bignat_of_pos a)) - | GRef (a, _) when GlobRef.equal a glob_xH -> Bigint.one - | _ -> raise Non_closed_number - ) x - -let uninterp_positive (AnyGlobConstr p) = - try - Some (bignat_of_pos p) - with Non_closed_number -> - None - -(************************************************************************) -(* Declaring interpreters and uninterpreters for positive *) -(************************************************************************) - -let _ = Notation.declare_numeral_interpreter "positive_scope" - (positive_path,binnums) - interp_positive - ([DAst.make @@ GRef (glob_xI, None); - DAst.make @@ GRef (glob_xO, None); - DAst.make @@ GRef (glob_xH, None)], - uninterp_positive, - true) diff --git a/plugins/syntax/positive_syntax_plugin.mlpack b/plugins/syntax/positive_syntax_plugin.mlpack deleted file mode 100644 index ac8f3c425c..0000000000 --- a/plugins/syntax/positive_syntax_plugin.mlpack +++ /dev/null @@ -1 +0,0 @@ -Positive_syntax diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml index 94aa143350..04946c158b 100644 --- a/plugins/syntax/r_syntax.ml +++ b/plugins/syntax/r_syntax.ml @@ -131,9 +131,19 @@ let uninterp_r (AnyGlobConstr p) = with Non_closed_number -> None -let _ = Notation.declare_numeral_interpreter "R_scope" - (r_path,["Coq";"Reals";"Rdefinitions"]) - r_of_int - ([DAst.make @@ GRef (glob_IZR, None)], - uninterp_r, - false) +open Notation + +let at_declare_ml_module f x = + Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name + +let r_scope = "R_scope" + +let _ = + register_bignumeral_interpretation r_scope (r_of_int,uninterp_r); + at_declare_ml_module enable_prim_token_interpretation + { pt_local = false; + pt_scope = r_scope; + pt_uid = r_scope; + pt_required = (r_path,["Coq";"Reals";"Rdefinitions"]); + pt_refs = [glob_IZR]; + pt_in_match = false } diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml index c22869f4d6..640bcfde91 100644 --- a/plugins/syntax/string_syntax.ml +++ b/plugins/syntax/string_syntax.ml @@ -64,10 +64,18 @@ let uninterp_string (AnyGlobConstr r) = with Non_closed_string -> None +open Notation + +let at_declare_ml_module f x = + Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name + let _ = - Notation.declare_string_interpreter "string_scope" - (string_path,["Coq";"Strings";"String"]) - interp_string - ([DAst.make @@ GRef (static_glob_String,None); - DAst.make @@ GRef (static_glob_EmptyString,None)], - uninterp_string, true) + let sc = "string_scope" in + register_string_interpretation sc (interp_string,uninterp_string); + at_declare_ml_module enable_prim_token_interpretation + { pt_local = false; + pt_scope = sc; + pt_uid = sc; + pt_required = (string_path,["Coq";"Strings";"String"]); + pt_refs = [static_glob_String; static_glob_EmptyString]; + pt_in_match = true } diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml deleted file mode 100644 index 2534162e36..0000000000 --- a/plugins/syntax/z_syntax.ml +++ /dev/null @@ -1,78 +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) *) -(************************************************************************) - -open Names -open Bigint -open Positive_syntax_plugin.Positive_syntax - -(* Poor's man DECLARE PLUGIN *) -let __coq_plugin_name = "z_syntax_plugin" -let () = Mltop.add_known_module __coq_plugin_name - -(**********************************************************************) -(* Parsing Z via scopes *) -(**********************************************************************) - -open Globnames -open Glob_term - -let binnums = ["Coq";"Numbers";"BinNums"] - -let make_dir l = DirPath.make (List.rev_map Id.of_string l) -let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id) - -(* TODO: temporary hack *) -let make_kn dir id = Globnames.encode_mind dir id - -let z_path = make_path binnums "Z" -let z_kn = make_kn (make_dir binnums) (Id.of_string "Z") -let glob_z = IndRef (z_kn,0) -let path_of_ZERO = ((z_kn,0),1) -let path_of_POS = ((z_kn,0),2) -let path_of_NEG = ((z_kn,0),3) -let glob_ZERO = ConstructRef path_of_ZERO -let glob_POS = ConstructRef path_of_POS -let glob_NEG = ConstructRef path_of_NEG - -let z_of_int ?loc n = - if not (Bigint.equal n zero) then - let sgn, n = - if is_pos_or_zero n then glob_POS, n else glob_NEG, Bigint.neg n in - DAst.make ?loc @@ GApp(DAst.make ?loc @@ GRef(sgn,None), [pos_of_bignat ?loc n]) - else - DAst.make ?loc @@ GRef(glob_ZERO, None) - -(**********************************************************************) -(* Printing Z via scopes *) -(**********************************************************************) - -let bigint_of_z z = DAst.with_val (function - | GApp (r, [a]) when is_gr r glob_POS -> bignat_of_pos a - | GApp (r, [a]) when is_gr r glob_NEG -> Bigint.neg (bignat_of_pos a) - | GRef (a, _) when GlobRef.equal a glob_ZERO -> Bigint.zero - | _ -> raise Non_closed_number - ) z - -let uninterp_z (AnyGlobConstr p) = - try - Some (bigint_of_z p) - with Non_closed_number -> None - -(************************************************************************) -(* Declaring interpreters and uninterpreters for Z *) - -let _ = Notation.declare_numeral_interpreter "Z_scope" - (z_path,binnums) - z_of_int - ([DAst.make @@ GRef (glob_ZERO, None); - DAst.make @@ GRef (glob_POS, None); - DAst.make @@ GRef (glob_NEG, None)], - uninterp_z, - true) diff --git a/plugins/syntax/z_syntax_plugin.mlpack b/plugins/syntax/z_syntax_plugin.mlpack deleted file mode 100644 index 411260c04c..0000000000 --- a/plugins/syntax/z_syntax_plugin.mlpack +++ /dev/null @@ -1 +0,0 @@ -Z_syntax diff --git a/plugins/xml/README b/plugins/xml/README deleted file mode 100644 index 3128189929..0000000000 --- a/plugins/xml/README +++ /dev/null @@ -1,4 +0,0 @@ -The xml export plugin for Coq has been removed from the sources. -A backward compatible plug-in will be provided as a third-party plugin. -For more informations, contact -Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>. diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml index da6e26cc4b..fc24e9b3a9 100644 --- a/pretyping/cbv.ml +++ b/pretyping/cbv.ml @@ -455,7 +455,8 @@ let cbv_norm infos constr = (* constant bodies are normalized at the first expansion *) let create_cbv_infos flgs env sigma = let infos = create - (fun old_info tab c -> cbv_stack_term { tab; infos = old_info; sigma } TOP (subs_id 0) c) + ~share:true (** Not used by cbv *) + ~repr:(fun old_info tab c -> cbv_stack_term { tab; infos = old_info; sigma } TOP (subs_id 0) c) flgs env (Reductionops.safe_evar_value sigma) in diff --git a/pretyping/dune b/pretyping/dune new file mode 100644 index 0000000000..6609b4e328 --- /dev/null +++ b/pretyping/dune @@ -0,0 +1,6 @@ +(library + (name pretyping) + (synopsis "Coq's Type Inference Component (Pretyper)") + (public_name coq.pretyping) + (wrapped false) + (libraries camlp5.gramlib engine)) diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml index 5df41ef76a..246acfc92e 100644 --- a/pretyping/nativenorm.ml +++ b/pretyping/nativenorm.ml @@ -354,9 +354,8 @@ and nf_atom_type env sigma atom = let env = push_rel (LocalAssum (n,dom)) env in let codom,s2 = nf_type_sort env sigma (codom vn) in mkProd(n,dom,codom), Typeops.type_of_product env n s1 s2 - | Aevar(evk,ty,args) -> - let ty = nf_type env sigma ty in - nf_evar env sigma evk ty args + | Aevar(evk,args) -> + nf_evar env sigma evk args | Ameta(mv,ty) -> let ty = nf_type env sigma ty in mkMeta mv, ty @@ -398,22 +397,27 @@ and nf_predicate env sigma ind mip params v pT = mkLambda(name,dom,body) | _ -> nf_type env sigma v -and nf_evar env sigma evk ty args = +and nf_evar env sigma evk args = let evi = try Evd.find sigma evk with Not_found -> assert false in let hyps = Environ.named_context_of_val (Evd.evar_filtered_hyps evi) in + let ty = EConstr.Unsafe.to_constr @@ Evd.evar_concl evi in if List.is_empty hyps then begin assert (Int.equal (Array.length args) 0); mkEvar (evk, [||]), ty end else + (** 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 ty hyps in let ty, args = nf_args env sigma args t in - mkEvar (evk, Array.of_list args), ty + (** nf_args takes arguments in the reverse order but produces them in the + correct one, so we have to reverse them again for the evar node *) + mkEvar (evk, Array.rev_of_list args), ty let evars_of_evar_map sigma = { Nativelambda.evars_val = Evd.existential_opt_value0 sigma; - Nativelambda.evars_typ = Evd.existential_type0 sigma; Nativelambda.evars_metas = Evd.meta_type0 sigma } (* fork perf process, return profiler's process id *) diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 3b9a8e6a1d..a315376aca 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -68,9 +68,7 @@ type t = { } let get_extra env sigma = - let open Context.Named.Declaration in - let ids = List.map get_id (named_context env) in - let avoid = List.fold_right Id.Set.add ids Id.Set.empty in + let avoid = Environ.ids_of_named_context_val (Environ.named_context_val env) in Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context sigma d acc) (rel_context env) ~init:(empty_csubst, avoid, named_context env) diff --git a/printing/dune b/printing/dune new file mode 100644 index 0000000000..3392342165 --- /dev/null +++ b/printing/dune @@ -0,0 +1,6 @@ +(library + (name printing) + (synopsis "Coq's Term Pretty Printing Library") + (public_name coq.printing) + (wrapped false) + (libraries parsing proofs)) diff --git a/proofs/dune b/proofs/dune new file mode 100644 index 0000000000..679c45f6bf --- /dev/null +++ b/proofs/dune @@ -0,0 +1,6 @@ +(library + (name proofs) + (synopsis "Coq's Higher-level Refinement Proof Engine and Top-level Proof Structure") + (public_name coq.proofs) + (wrapped false) + (libraries interp)) diff --git a/proofs/refine.ml b/proofs/refine.ml index b64e7a2e5e..198e057ebc 100644 --- a/proofs/refine.ml +++ b/proofs/refine.ml @@ -49,20 +49,14 @@ let (pr_constrv,pr_constr) = (* Get the side-effect's constant declarations to update the monad's * environmnent *) -let add_if_undefined kn cb env = - try ignore(Environ.lookup_constant kn env); env - with Not_found -> Environ.add_constant kn cb env +let add_if_undefined env eff = + let open Entries in + try ignore(Environ.lookup_constant eff.seff_constant env); env + with Not_found -> Environ.add_constant eff.seff_constant eff.seff_body env (* Add the side effects to the monad's environment, if not already done. *) -let add_side_effect env = function - | { Entries.eff = Entries.SEsubproof (kn, cb, eff_env) } -> - add_if_undefined kn cb env - | { Entries.eff = Entries.SEscheme (l,_) } -> - List.fold_left (fun env (_,kn,cb,eff_env) -> - add_if_undefined kn cb env) env l - -let add_side_effects env effects = - List.fold_left (fun env eff -> add_side_effect env eff) env effects +let add_side_effects env eff = + List.fold_left add_if_undefined env eff let generic_refine ~typecheck f gl = let sigma = Proofview.Goal.sigma gl in diff --git a/stm/dune b/stm/dune new file mode 100644 index 0000000000..c369bd00fb --- /dev/null +++ b/stm/dune @@ -0,0 +1,6 @@ +(library + (name stm) + (synopsis "Coq's Document Manager and Proof Checking Scheduler") + (public_name coq.stm) + (wrapped false) + (libraries vernac)) diff --git a/tactics/dune b/tactics/dune new file mode 100644 index 0000000000..908dde5253 --- /dev/null +++ b/tactics/dune @@ -0,0 +1,6 @@ +(library + (name tactics) + (synopsis "Coq's Core Tactics [ML implementation]") + (public_name coq.tactics) + (wrapped false) + (libraries printing)) diff --git a/tactics/ind_tables.ml b/tactics/ind_tables.ml index 21520f5d2b..e4013152e6 100644 --- a/tactics/ind_tables.ml +++ b/tactics/ind_tables.ml @@ -154,7 +154,7 @@ let define_individual_scheme_base kind suff f mode idopt (mind,i as ind) = | None -> add_suffix mib.mind_packets.(i).mind_typename suff in let const = define mode id c (Declareops.inductive_is_polymorphic mib) ctx in declare_scheme kind [|ind,const|]; - const, Safe_typing.add_private + const, Safe_typing.concat_private (Safe_typing.private_con_of_scheme ~kind (Global.safe_env()) [ind,const]) eff let define_individual_scheme kind mode names (mind,i as ind) = @@ -174,7 +174,7 @@ let define_mutual_scheme_base kind suff f mode names mind = let schemes = Array.mapi (fun i cst -> ((mind,i),cst)) consts in declare_scheme kind schemes; consts, - Safe_typing.add_private + Safe_typing.concat_private (Safe_typing.private_con_of_scheme ~kind (Global.safe_env()) (Array.to_list schemes)) eff @@ -187,7 +187,7 @@ let define_mutual_scheme kind mode names mind = let find_scheme_on_env_too kind ind = let s = String.Map.find kind (Indmap.find ind !scheme_map) in - s, Safe_typing.add_private + s, Safe_typing.concat_private (Safe_typing.private_con_of_scheme ~kind (Global.safe_env()) [ind, s]) Safe_typing.empty_private_constants diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 2a8ebe08ca..d536204ec3 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -125,7 +125,7 @@ let unsafe_intro env store decl b = let ninst = mkRel 1 :: inst in let nb = subst1 (mkVar (NamedDecl.get_id decl)) b in let (sigma, ev) = new_evar_instance nctx sigma nb ~principal:true ~store ninst in - (sigma, mkNamedLambda_or_LetIn decl ev) + (sigma, mkLambda_or_LetIn (NamedDecl.to_rel_decl decl) ev) end let introduction id = @@ -5007,7 +5007,7 @@ let cache_term_by_tactic_then ~opaque ?(goal_type=None) id gk tac tacK = let evd = Evd.set_universe_context evd ectx in let open Safe_typing in let eff = private_con_of_con (Global.safe_env ()) cst in - let effs = add_private eff + let effs = concat_private eff Entries.(snd (Future.force const.const_entry_body)) in let solve = Proofview.tclEFFECTS effs <*> diff --git a/test-suite/bugs/closed/4527.v b/test-suite/bugs/closed/4527.v index 117d6523a8..f8cedfff6e 100644 --- a/test-suite/bugs/closed/4527.v +++ b/test-suite/bugs/closed/4527.v @@ -23,7 +23,9 @@ Module Export Datatypes. Set Implicit Arguments. Notation nat := Coq.Init.Datatypes.nat. +Notation O := Coq.Init.Datatypes.O. Notation S := Coq.Init.Datatypes.S. +Notation two := (S (S O)). Record prod (A B : Type) := pair { fst : A ; snd : B }. @@ -159,7 +161,7 @@ End Adjointify. (n : nat) {A : Type@{i}} {B : Type@{j}} (f : A -> B) (C : B -> Type@{k}) : Type@{l} := match n with - | 0 => Unit@{l} + | O => Unit@{l} | S n => (forall (g : forall a, C (f a)), ExtensionAlong@{i j k l l} f C g) * forall (h k : forall b, C b), @@ -220,12 +222,12 @@ Section ORecursion. Definition O_indpaths {P Q : Type} {Q_inO : In O Q} (g h : O P -> Q) (p : g o to O P == h o to O P) : g == h - := (fst (snd (extendable_to_O O 2) g h) p).1. + := (fst (snd (extendable_to_O O two) g h) p).1. Definition O_indpaths_beta {P Q : Type} {Q_inO : In O Q} (g h : O P -> Q) (p : g o (to O P) == h o (to O P)) (x : P) : O_indpaths g h p (to O P x) = p x - := (fst (snd (extendable_to_O O 2) g h) p).2 x. + := (fst (snd (extendable_to_O O two) g h) p).2 x. End ORecursion. diff --git a/test-suite/bugs/closed/4533.v b/test-suite/bugs/closed/4533.v index c3e0da1117..fd2380a070 100644 --- a/test-suite/bugs/closed/4533.v +++ b/test-suite/bugs/closed/4533.v @@ -17,7 +17,10 @@ Notation "A -> B" := (forall (_ : A), B) : type_scope. Module Export Datatypes. Set Implicit Arguments. Notation nat := Coq.Init.Datatypes.nat. + Notation O := Coq.Init.Datatypes.O. Notation S := Coq.Init.Datatypes.S. + Notation one := (S O). + Notation two := (S one). Record prod (A B : Type) := pair { fst : A ; snd : B }. Notation "x * y" := (prod x y) : type_scope. Delimit Scope nat_scope with nat. @@ -109,7 +112,7 @@ Fixpoint ExtendableAlong@{i j k l} (n : nat) {A : Type@{i}} {B : Type@{j}} (f : A -> B) (C : B -> Type@{k}) : Type@{l} := match n with - | 0 => Unit@{l} + | O => Unit@{l} | S n => (forall (g : forall a, C (f a)), ExtensionAlong@{i j k l l} f C g) * forall (h k : forall b, C b), @@ -160,17 +163,17 @@ Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). Definition O_rec {P Q : Type} {Q_inO : In O Q} (f : P -> Q) : O P -> Q - := (fst (extendable_to_O O 1%nat) f).1. + := (fst (extendable_to_O O one) f).1. Definition O_rec_beta {P Q : Type} {Q_inO : In O Q} (f : P -> Q) (x : P) : O_rec f (to O P x) = f x - := (fst (extendable_to_O O 1%nat) f).2 x. + := (fst (extendable_to_O O one) f).2 x. Definition O_indpaths {P Q : Type} {Q_inO : In O Q} (g h : O P -> Q) (p : g o to O P == h o to O P) : g == h - := (fst (snd (extendable_to_O O 2) g h) p).1. + := (fst (snd (extendable_to_O O two) g h) p).1. End ORecursion. diff --git a/test-suite/bugs/closed/4544.v b/test-suite/bugs/closed/4544.v index 4ad53bc629..13c47edc8f 100644 --- a/test-suite/bugs/closed/4544.v +++ b/test-suite/bugs/closed/4544.v @@ -19,6 +19,7 @@ Inductive sum (A B : Type) : Type := | inl : A -> sum A B | inr : B -> sum A B. Notation nat := Coq.Init.Datatypes.nat. +Notation O := Coq.Init.Datatypes.O. Notation S := Coq.Init.Datatypes.S. Notation "x + y" := (sum x y) : type_scope. @@ -449,7 +450,7 @@ Section Extensions. (n : nat) {A : Type@{i}} {B : Type@{j}} (f : A -> B) (C : B -> Type@{k}) : Type@{l} := match n with - | 0 => Unit@{l} + | O => Unit@{l} | S n => (forall (g : forall a, C (f a)), ExtensionAlong@{i j k l l} f C g) * forall (h k : forall b, C b), diff --git a/test-suite/bugs/closed/7867.v b/test-suite/bugs/closed/7867.v new file mode 100644 index 0000000000..d0c7902756 --- /dev/null +++ b/test-suite/bugs/closed/7867.v @@ -0,0 +1,4 @@ +(* Was a printer anomaly due to an internal lambda with no binders *) + +Class class := { foo : nat }. +Fail Instance : class := { foo := 0 ; bar := 0 }. diff --git a/test-suite/bugs/closed/7900.v b/test-suite/bugs/closed/7900.v new file mode 100644 index 0000000000..583ef0ef3b --- /dev/null +++ b/test-suite/bugs/closed/7900.v @@ -0,0 +1,53 @@ +Require Import Coq.Program.Program. +(* Set Universe Polymorphism. *) +Set Printing Universes. + +Axiom ALL : forall {T:Prop}, T. + +Inductive Expr : Set := E (a : Expr). + +Parameter Value : Set. + +Fixpoint eval (e: Expr): Value := + match e with + | E a => eval a + end. + +Class Quote (n: Value) : Set := + { quote: Expr + ; eval_quote: eval quote = n }. + +Program Definition quote_mult n + `{!Quote n} : Quote n := + {| quote := E (quote (n:=n)) |}. + +Set Printing Universes. +Next Obligation. +Proof. + Show Universes. + destruct Quote0 as [q eq]. + Show Universes. + rewrite <- eq. + clear n eq. + Show Universes. + apply ALL. + Show Universes. +Qed. +Print quote_mult_obligation_1. +(* quote_mult_obligation_1@{} = +let Top_internal_eq_rew_dep := + fun (A : Type@{Coq.Init.Logic.8}) (x : A) (P : forall a : A, x = a -> Type@{Top.5} (* <- XXX *)) + (f : P x eq_refl) (y : A) (e : x = y) => + match e as e0 in (_ = y0) return (P y0 e0) with + | eq_refl => f + end in +fun (n : Value) (Quote0 : Quote n) => +match Quote0 as q return (eval quote = n) with +| {| quote := q; eval_quote := eq0 |} => + Top_internal_eq_rew_dep Value (eval q) (fun (n0 : Value) (eq1 : eval q = n0) => eval quote = n0) + ALL n eq0 +end + : forall (n : Value) (Quote0 : Quote n), eval (E quote) = n + +quote_mult_obligation_1 is universe polymorphic +*) diff --git a/test-suite/bugs/closed/7967.v b/test-suite/bugs/closed/7967.v new file mode 100644 index 0000000000..2c8855fd54 --- /dev/null +++ b/test-suite/bugs/closed/7967.v @@ -0,0 +1,2 @@ +Set Universe Polymorphism. +Inductive A@{} : Set := B : ltac:(let y := constr:(Type) in exact nat) -> A. diff --git a/test-suite/bugs/closed/8106.v b/test-suite/bugs/closed/8106.v new file mode 100644 index 0000000000..a711c5adef --- /dev/null +++ b/test-suite/bugs/closed/8106.v @@ -0,0 +1,4 @@ +(* Was raising an anomaly "already assigned a level" on the second line *) + +Notation "c1 ; c2" := (c1 + c2) (only printing, at level 76, right associativity, c1 at level 76, c2 at level 76). +Notation "c1 ; c2" := (c1 + c2) (only parsing, at level 76, right associativity, c2 at level 76). diff --git a/test-suite/bugs/closed/8121.v b/test-suite/bugs/closed/8121.v new file mode 100644 index 0000000000..99267612ca --- /dev/null +++ b/test-suite/bugs/closed/8121.v @@ -0,0 +1,46 @@ +Require Import Coq.Strings.String. + +Section T. + Eval native_compute in let x := tt in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval native_compute in let _ := Set in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval native_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 native_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. native_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 native_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. native_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 native_compute in _. +(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. native_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 native_compute in _. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) + Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) +End S2. 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/interactive/PrimNotation.v b/test-suite/interactive/PrimNotation.v new file mode 100644 index 0000000000..07986b0df3 --- /dev/null +++ b/test-suite/interactive/PrimNotation.v @@ -0,0 +1,64 @@ +(* Until recently, the Notation.declare_numeral_notation wasn't synchronized + w.r.t. backtracking. This should be ok now. + This test is pretty artificial (we must declare Z_scope for this to work). +*) + +Delimit Scope Z_scope with Z. +Open Scope Z_scope. +Check let v := 0 in v : nat. +(* let v := 0 in v : nat : nat *) +Require BinInt. +Check let v := 0 in v : BinNums.Z. +(* let v := 0 in v : BinNums.Z : BinNums.Z *) +Back 2. +Check let v := 0 in v : nat. +(* Expected answer: let v := 0 in v : nat : nat *) +(* Used to fail with: +Error: Cannot interpret in Z_scope without requiring first module BinNums. +*) + +Local Set Universe Polymorphism. +Delimit Scope punit_scope with punit. +Delimit Scope pcunit_scope with pcunit. +Delimit Scope int_scope with int. +Numeral Notation Decimal.int Decimal.int_of_int Decimal.int_of_int : int_scope. +Module A. + NonCumulative Inductive punit@{u} : Type@{u} := ptt. + Cumulative Inductive pcunit@{u} : Type@{u} := pctt. + Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. + Definition to_pcunit : Decimal.int -> option pcunit + := fun v => match v with 0%int => Some pctt | _ => None end. + Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. + Definition of_pcunit : pcunit -> Decimal.uint := fun _ => Nat.to_uint 0. + Numeral Notation punit to_punit of_punit : punit_scope. + Check let v := 0%punit in v : punit. + Back 2. + Numeral Notation pcunit to_pcunit of_pcunit : punit_scope. + Check let v := 0%punit in v : pcunit. +End A. +Reset A. +Local Unset Universe Polymorphism. +Module A. + Inductive punit : Set := ptt. + Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. + Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. + Numeral Notation punit to_punit of_punit : punit_scope. + Check let v := 0%punit in v : punit. +End A. +Local Set Universe Polymorphism. +Inductive punit@{u} : Type@{u} := ptt. +Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. +Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. +Numeral Notation punit to_punit of_punit : punit_scope. +Check let v := 0%punit in v : punit. +Back 6. (* check backtracking of registering universe polymorphic constants *) +Local Unset Universe Polymorphism. +Inductive punit : Set := ptt. +Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. +Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. +Numeral Notation punit to_punit of_punit : punit_scope. +Check let v := 0%punit in v : punit. diff --git a/test-suite/success/ssr_delayed_clear_rename.v b/test-suite/ssr/delayed_clear_rename.v index 951e5aff79..951e5aff79 100644 --- a/test-suite/success/ssr_delayed_clear_rename.v +++ b/test-suite/ssr/delayed_clear_rename.v diff --git a/test-suite/ssr/ssr_rew_illtyped.v b/test-suite/ssr/rewrite_illtyped.v index 7358068c8d..7358068c8d 100644 --- a/test-suite/ssr/ssr_rew_illtyped.v +++ b/test-suite/ssr/rewrite_illtyped.v diff --git a/test-suite/success/Compat88.v b/test-suite/success/Compat88.v new file mode 100644 index 0000000000..e2045900d5 --- /dev/null +++ b/test-suite/success/Compat88.v @@ -0,0 +1,18 @@ +(* -*- coq-prog-args: ("-compat" "8.8") -*- *) +(** Check that various syntax usage is available without importing + relevant files. *) +Require Coq.Strings.Ascii Coq.Strings.String. +Require Coq.ZArith.BinIntDef Coq.PArith.BinPosDef Coq.NArith.BinNatDef. +Require Coq.Reals.Rdefinitions. +Require Coq.Numbers.Cyclic.Int31.Cyclic31. + +Require Import Coq.Compat.Coq88. (* XXX FIXME Should not need [Require], see https://github.com/coq/coq/issues/8311 *) + +Check String.String "a" String.EmptyString. +Check String.eqb "a" "a". +Check Nat.eqb 1 1. +Check BinNat.N.eqb 1 1. +Check BinInt.Z.eqb 1 1. +Check BinPos.Pos.eqb 1 1. +Check Rdefinitions.Rplus 1 1. +Check Int31.iszero 1. diff --git a/test-suite/success/CompatCurrentFlag.v b/test-suite/success/CompatCurrentFlag.v new file mode 100644 index 0000000000..288c9d1da0 --- /dev/null +++ b/test-suite/success/CompatCurrentFlag.v @@ -0,0 +1,3 @@ +(* -*- coq-prog-args: ("-compat" "8.8") -*- *) +(** Check that the current compatibility flag actually requires the relevant modules. *) +Import Coq.Compat.Coq88. diff --git a/test-suite/success/CompatOldFlag.v b/test-suite/success/CompatOldFlag.v new file mode 100644 index 0000000000..b7bbc505b4 --- /dev/null +++ b/test-suite/success/CompatOldFlag.v @@ -0,0 +1,5 @@ +(* -*- coq-prog-args: ("-compat" "8.6") -*- *) +(** Check that the current-minus-two compatibility flag actually requires the relevant modules. *) +Import Coq.Compat.Coq88. +Import Coq.Compat.Coq87. +Import Coq.Compat.Coq86. diff --git a/test-suite/success/CompatPreviousFlag.v b/test-suite/success/CompatPreviousFlag.v new file mode 100644 index 0000000000..9cfe60390f --- /dev/null +++ b/test-suite/success/CompatPreviousFlag.v @@ -0,0 +1,4 @@ +(* -*- coq-prog-args: ("-compat" "8.7") -*- *) +(** Check that the current-minus-one compatibility flag actually requires the relevant modules. *) +Import Coq.Compat.Coq88. +Import Coq.Compat.Coq87. diff --git a/test-suite/success/NumeralNotations.v b/test-suite/success/NumeralNotations.v new file mode 100644 index 0000000000..47ef381270 --- /dev/null +++ b/test-suite/success/NumeralNotations.v @@ -0,0 +1,302 @@ +(* Test that we fail, rather than raising anomalies, on opaque terms during interpretation *) + +(* https://github.com/coq/coq/pull/8064#discussion_r202497516 *) +Module Test1. + Axiom hold : forall {A B C}, A -> B -> C. + Definition opaque3 (x : Decimal.int) : Decimal.int := hold x (fix f (x : nat) : nat := match x with O => O | S n => S (f n) end). + Numeral Notation Decimal.int opaque3 opaque3 : opaque_scope. + Delimit Scope opaque_scope with opaque. + Fail Check 1%opaque. +End Test1. + +(* https://github.com/coq/coq/pull/8064#discussion_r202497990 *) +Module Test2. + Axiom opaque4 : option Decimal.int. + Definition opaque6 (x : Decimal.int) : option Decimal.int := opaque4. + Numeral Notation Decimal.int opaque6 opaque6 : opaque_scope. + Delimit Scope opaque_scope with opaque. + Open Scope opaque_scope. + Fail Check 1%opaque. +End Test2. + +Module Test3. + Inductive silly := SILLY (v : Decimal.uint) (f : forall A, A -> A). + Definition to_silly (v : Decimal.uint) := SILLY v (fun _ x => x). + Definition of_silly (v : silly) := match v with SILLY v _ => v end. + Numeral Notation silly to_silly of_silly : silly_scope. + Delimit Scope silly_scope with silly. + Fail Check 1%silly. +End Test3. + + +Module Test4. + Polymorphic NonCumulative Inductive punit := ptt. + Polymorphic Definition pto_punit (v : Decimal.uint) : option punit := match Nat.of_uint v with O => Some ptt | _ => None end. + Polymorphic Definition pto_punit_all (v : Decimal.uint) : punit := ptt. + Polymorphic Definition pof_punit (v : punit) : Decimal.uint := Nat.to_uint 0. + Definition to_punit (v : Decimal.uint) : option punit := match Nat.of_uint v with O => Some ptt | _ => None end. + Definition of_punit (v : punit) : Decimal.uint := Nat.to_uint 0. + Polymorphic Definition pto_unit (v : Decimal.uint) : option unit := match Nat.of_uint v with O => Some tt | _ => None end. + Polymorphic Definition pof_unit (v : unit) : Decimal.uint := Nat.to_uint 0. + Definition to_unit (v : Decimal.uint) : option unit := match Nat.of_uint v with O => Some tt | _ => None end. + Definition of_unit (v : unit) : Decimal.uint := Nat.to_uint 0. + Numeral Notation punit to_punit of_punit : pto. + Numeral Notation punit pto_punit of_punit : ppo. + Numeral Notation punit to_punit pof_punit : ptp. + Numeral Notation punit pto_punit pof_punit : ppp. + Numeral Notation unit to_unit of_unit : uto. + Delimit Scope pto with pto. + Delimit Scope ppo with ppo. + Delimit Scope ptp with ptp. + Delimit Scope ppp with ppp. + Delimit Scope uto with uto. + Check let v := 0%pto in v : punit. + Check let v := 0%ppo in v : punit. + Check let v := 0%ptp in v : punit. + Check let v := 0%ppp in v : punit. + Check let v := 0%uto in v : unit. + Fail Check 1%uto. + Fail Check (-1)%uto. + Numeral Notation unit pto_unit of_unit : upo. + Numeral Notation unit to_unit pof_unit : utp. + Numeral Notation unit pto_unit pof_unit : upp. + Delimit Scope upo with upo. + Delimit Scope utp with utp. + Delimit Scope upp with upp. + Check let v := 0%upo in v : unit. + Check let v := 0%utp in v : unit. + Check let v := 0%upp in v : unit. + + Polymorphic Definition pto_punits := pto_punit_all@{Set}. + Polymorphic Definition pof_punits := pof_punit@{Set}. + Numeral Notation punit pto_punits pof_punits : ppps (abstract after 1). + Delimit Scope ppps with ppps. + Universe u. + Constraint Set < u. + Check let v := 0%ppps in v : punit@{u}. (* Check that universes are refreshed *) + Fail Check let v := 1%ppps in v : punit@{u}. (* Note that universes are not refreshed here *) +End Test4. + +Module Test5. + Check S. (* At one point gave Error: Anomaly "Uncaught exception Pretype_errors.PretypeError(_, _, _)." Please report at http://coq.inria.fr/bugs/. *) +End Test5. + +Module Test6. + (* Check that numeral notations on enormous terms don't take forever to print/parse *) + (* Ackerman definition from https://stackoverflow.com/a/10303475/377022 *) + Fixpoint ack (n m : nat) : nat := + match n with + | O => S m + | S p => let fix ackn (m : nat) := + match m with + | O => ack p 1 + | S q => ack p (ackn q) + end + in ackn m + end. + + Timeout 1 Check (S (ack 4 4)). (* should be instantaneous *) + + Local Set Primitive Projections. + Record > wnat := wrap { unwrap :> nat }. + Definition to_uint (x : wnat) : Decimal.uint := Nat.to_uint x. + Definition of_uint (x : Decimal.uint) : wnat := Nat.of_uint x. + Module Export Scopes. + Delimit Scope wnat_scope with wnat. + End Scopes. + Module Export Notations. + Export Scopes. + Numeral Notation wnat of_uint to_uint : wnat_scope (abstract after 5000). + End Notations. + Check let v := 0%wnat in v : wnat. + Check wrap O. + Timeout 1 Check wrap (ack 4 4). (* should be instantaneous *) +End Test6. + +Module Test6_2. + Import Test6.Scopes. + Check Test6.wrap 0. + Import Test6.Notations. + Check let v := 0%wnat in v : Test6.wnat. +End Test6_2. + +Module Test7. + Local Set Primitive Projections. + Record wuint := wrap { unwrap : Decimal.uint }. + Delimit Scope wuint_scope with wuint. + Numeral Notation wuint wrap unwrap : wuint_scope. + Check let v := 0%wuint in v : wuint. + Check let v := 1%wuint in v : wuint. +End Test7. + +Module Test8. + Local Set Primitive Projections. + Record wuint := wrap { unwrap : Decimal.uint }. + Delimit Scope wuint8_scope with wuint8. + Delimit Scope wuint8'_scope with wuint8'. + Section with_var. + Context (dummy : unit). + Definition wrap' := let __ := dummy in wrap. + Definition unwrap' := let __ := dummy in unwrap. + Numeral Notation wuint wrap' unwrap' : wuint8_scope. + Check let v := 0%wuint8 in v : wuint. + End with_var. + Check let v := 0%wuint8 in v : nat. + Fail Check let v := 0%wuint8 in v : wuint. + Compute wrap (Nat.to_uint 0). + + Notation wrap'' := wrap. + Notation unwrap'' := unwrap. + Numeral Notation wuint wrap'' unwrap'' : wuint8'_scope. + Check let v := 0%wuint8' in v : wuint. +End Test8. + +Module Test9. + Delimit Scope wuint9_scope with wuint9. + Delimit Scope wuint9'_scope with wuint9'. + Section with_let. + Local Set Primitive Projections. + Record wuint := wrap { unwrap : Decimal.uint }. + Let wrap' := wrap. + Let unwrap' := unwrap. + Local Notation wrap'' := wrap. + Local Notation unwrap'' := unwrap. + Numeral Notation wuint wrap' unwrap' : wuint9_scope. + Check let v := 0%wuint9 in v : wuint. + Numeral Notation wuint wrap'' unwrap'' : wuint9'_scope. + Check let v := 0%wuint9' in v : wuint. + End with_let. + Check let v := 0%wuint9 in v : nat. + Fail Check let v := 0%wuint9 in v : wuint. +End Test9. + +Module Test10. + (* Test that it is only a warning to add abstract after to an optional parsing function *) + Definition to_uint (v : unit) := Nat.to_uint 0. + Definition of_uint (v : Decimal.uint) := match Nat.of_uint v with O => Some tt | _ => None end. + Definition of_any_uint (v : Decimal.uint) := tt. + Delimit Scope unit_scope with unit. + Delimit Scope unit2_scope with unit2. + Numeral Notation unit of_uint to_uint : unit_scope (abstract after 1). + Local Set Warnings Append "+abstract-large-number-no-op". + (* Check that there is actually a warning here *) + Fail Numeral Notation unit of_uint to_uint : unit2_scope (abstract after 1). + (* Check that there is no warning here *) + Numeral Notation unit of_any_uint to_uint : unit2_scope (abstract after 1). +End Test10. + +Module Test11. + (* Test that numeral notations don't work on proof-local variables, especially not ones containing evars *) + Inductive unit11 := tt11. + Delimit Scope unit11_scope with unit11. + Goal True. + evar (to_uint : unit11 -> Decimal.uint). + evar (of_uint : Decimal.uint -> unit11). + Fail Numeral Notation unit11 of_uint to_uint : uint11_scope. + exact I. + Unshelve. + all: solve [ constructor ]. + Qed. +End Test11. + +Module Test12. + (* Test for numeral notations on context variables *) + Delimit Scope test12_scope with test12. + Section test12. + Context (to_uint : unit -> Decimal.uint) (of_uint : Decimal.uint -> unit). + + Numeral Notation unit of_uint to_uint : test12_scope. + Check let v := 1%test12 in v : unit. + End test12. +End Test12. + +Module Test13. + (* Test for numeral notations on notations which do not denote references *) + Delimit Scope test13_scope with test13. + Delimit Scope test13'_scope with test13'. + Delimit Scope test13''_scope with test13''. + Definition to_uint (x y : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Definition to_uint_good := to_uint tt. + Notation to_uint' := (to_uint tt). + Notation to_uint'' := (to_uint _). + Numeral Notation unit of_uint to_uint_good : test13_scope. + Check let v := 0%test13 in v : unit. + Fail Numeral Notation unit of_uint to_uint' : test13'_scope. + Fail Check let v := 0%test13' in v : unit. + Fail Numeral Notation unit of_uint to_uint'' : test13''_scope. + Fail Check let v := 0%test13'' in v : unit. +End Test13. + +Module Test14. + (* Test that numeral notations follow [Import], not [Require], and + also test that [Local Numeral Notation]s do not escape modules + nor sections. *) + Delimit Scope test14_scope with test14. + Delimit Scope test14'_scope with test14'. + Delimit Scope test14''_scope with test14''. + Delimit Scope test14'''_scope with test14'''. + Module Inner. + Definition to_uint (x : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Local Numeral Notation unit of_uint to_uint : test14_scope. + Global Numeral Notation unit of_uint to_uint : test14'_scope. + Check let v := 0%test14 in v : unit. + Check let v := 0%test14' in v : unit. + End Inner. + Fail Check let v := 0%test14 in v : unit. + Fail Check let v := 0%test14' in v : unit. + Import Inner. + Fail Check let v := 0%test14 in v : unit. + Check let v := 0%test14' in v : unit. + Section InnerSection. + Definition to_uint (x : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Local Numeral Notation unit of_uint to_uint : test14''_scope. + Fail Global Numeral Notation unit of_uint to_uint : test14'''_scope. + Check let v := 0%test14'' in v : unit. + Fail Check let v := 0%test14''' in v : unit. + End InnerSection. + Fail Check let v := 0%test14'' in v : unit. + Fail Check let v := 0%test14''' in v : unit. +End Test14. + +Module Test15. + (** Test module include *) + Delimit Scope test15_scope with test15. + Module Inner. + Definition to_uint (x : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Numeral Notation unit of_uint to_uint : test15_scope. + Check let v := 0%test15 in v : unit. + End Inner. + Module Inner2. + Include Inner. + Check let v := 0%test15 in v : unit. + End Inner2. + Import Inner Inner2. + Check let v := 0%test15 in v : unit. +End Test15. + +Module Test16. + (** Test functors *) + Delimit Scope test16_scope with test16. + Module Type A. + Axiom T : Set. + Axiom t : T. + End A. + Module F (a : A). + Inductive Foo := foo (_ : a.T). + Definition to_uint (x : Foo) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : Foo := foo a.t. + Global Numeral Notation Foo of_uint to_uint : test16_scope. + Check let v := 0%test16 in v : Foo. + End F. + Module a <: A. + Definition T : Set := unit. + Definition t : T := tt. + End a. + Module Import f := F a. + (** Ideally this should work, but it should definitely not anomaly *) + Fail Check let v := 0%test16 in v : Foo. +End Test16. diff --git a/theories/Compat/Coq88.v b/theories/Compat/Coq88.v index 4142af05d2..578425bfb5 100644 --- a/theories/Compat/Coq88.v +++ b/theories/Compat/Coq88.v @@ -9,3 +9,17 @@ (************************************************************************) (** Compatibility file for making Coq act similar to Coq v8.8 *) +(** In Coq 8.9, prim token notations follow [Import] rather than + [Require]. So we make all of the relevant notations accessible in + compatibility mode. *) +Require Coq.Strings.Ascii Coq.Strings.String. +Require Coq.ZArith.BinIntDef Coq.PArith.BinPosDef Coq.NArith.BinNatDef. +Require Coq.Reals.Rdefinitions. +Require Coq.Numbers.Cyclic.Int31.Int31. +Declare ML Module "string_syntax_plugin". +Declare ML Module "ascii_syntax_plugin". +Declare ML Module "r_syntax_plugin". +Declare ML Module "int31_syntax_plugin". +Numeral Notation BinNums.Z BinIntDef.Z.of_int BinIntDef.Z.to_int : Z_scope. +Numeral Notation BinNums.positive BinPosDef.Pos.of_int BinPosDef.Pos.to_int : positive_scope. +Numeral Notation BinNums.N BinNatDef.N.of_int BinNatDef.N.to_int : N_scope. diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index 05b741f0ac..1e6843d511 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -12,7 +12,6 @@ Set Implicit Arguments. Require Import Notations. Require Import Logic. -Declare ML Module "nat_syntax_plugin". (********************************************************************) (** * Datatypes with zero and one element *) diff --git a/theories/Init/Decimal.v b/theories/Init/Decimal.v index 57163b1b07..1ff00ec11c 100644 --- a/theories/Init/Decimal.v +++ b/theories/Init/Decimal.v @@ -42,10 +42,10 @@ Notation zero := (D0 Nil). Inductive int := Pos (d:uint) | Neg (d:uint). -Delimit Scope uint_scope with uint. -Bind Scope uint_scope with uint. -Delimit Scope int_scope with int. -Bind Scope int_scope with int. +Delimit Scope dec_uint_scope with uint. +Bind Scope dec_uint_scope with uint. +Delimit Scope dec_int_scope with int. +Bind Scope dec_int_scope with int. (** This representation favors simplicity over canonicity. For normalizing numbers, we need to remove head zero digits, @@ -161,3 +161,9 @@ with succ_double d := end. End Little. + +(** Pseudo-conversion functions used when declaring + Numeral Notations on [uint] and [int]. *) + +Definition uint_of_uint (i:uint) := i. +Definition int_of_int (i:int) := i. diff --git a/theories/Init/Nat.v b/theories/Init/Nat.v index ad1bc717c4..eb4ba0e5e6 100644 --- a/theories/Init/Nat.v +++ b/theories/Init/Nat.v @@ -24,6 +24,10 @@ Definition t := nat. (** ** Constants *) +Local Notation "0" := O. +Local Notation "1" := (S O). +Local Notation "2" := (S (S O)). + Definition zero := 0. Definition one := 1. Definition two := 2. diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index d5322d0945..65e5e76a22 100644 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -31,6 +31,7 @@ Require Import Logic. Require Coq.Init.Nat. Open Scope nat_scope. +Local Notation "0" := O. Definition eq_S := f_equal S. Definition f_equal_nat := f_equal (A:=nat). diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v index 802f18c0f2..6d98bcb34a 100644 --- a/theories/Init/Prelude.v +++ b/theories/Init/Prelude.v @@ -19,9 +19,24 @@ Require Export Peano. Require Export Coq.Init.Wf. Require Export Coq.Init.Tactics. Require Export Coq.Init.Tauto. -(* Initially available plugins - (+ nat_syntax_plugin loaded in Datatypes) *) +(* Some initially available plugins. See also: + - ltac_plugin (in Notations) + - tauto_plugin (in Tauto). +*) Declare ML Module "cc_plugin". Declare ML Module "ground_plugin". +Declare ML Module "numeral_notation_plugin". + +(* Parsing / printing of decimal numbers *) +Arguments Nat.of_uint d%dec_uint_scope. +Arguments Nat.of_int d%dec_int_scope. +Numeral Notation Decimal.uint Decimal.uint_of_uint Decimal.uint_of_uint + : dec_uint_scope. +Numeral Notation Decimal.int Decimal.int_of_int Decimal.int_of_int + : dec_int_scope. + +(* Parsing / printing of [nat] numbers *) +Numeral Notation nat Nat.of_uint Nat.to_uint : nat_scope (abstract after 5000). + (* Default substrings not considered by queries like SearchAbout *) Add Search Blacklist "_subproof" "_subterm" "Private_". diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v index 5d3ec5abc7..bd27f94abd 100644 --- a/theories/NArith/BinNat.v +++ b/theories/NArith/BinNat.v @@ -930,6 +930,8 @@ Bind Scope N_scope with N.t N. (** Exportation of notations *) +Numeral Notation N N.of_uint N.to_uint : N_scope. + Infix "+" := N.add : N_scope. Infix "-" := N.sub : N_scope. Infix "*" := N.mul : N_scope. diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v index 5de75537cb..be12fffaaf 100644 --- a/theories/NArith/BinNatDef.v +++ b/theories/NArith/BinNatDef.v @@ -13,6 +13,10 @@ Require Import BinPos. Local Open Scope N_scope. +Local Notation "0" := N0. +Local Notation "1" := (Npos 1). +Local Notation "2" := (Npos 2). + (**********************************************************************) (** * Binary natural numbers, definitions of operations *) (**********************************************************************) @@ -398,4 +402,9 @@ Definition to_uint n := Definition to_int n := Decimal.Pos (to_uint n). +Numeral Notation N of_uint to_uint : N_scope. + End N. + +(** Re-export the notation for those who just [Import NatIntDef] *) +Numeral Notation N N.of_uint N.to_uint : N_scope. diff --git a/theories/Numbers/AltBinNotations.v b/theories/Numbers/AltBinNotations.v new file mode 100644 index 0000000000..c7e3999691 --- /dev/null +++ b/theories/Numbers/AltBinNotations.v @@ -0,0 +1,69 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +(** * Alternative Binary Numeral Notations *) + +(** Faster but less safe parsers and printers of [positive], [N], [Z]. *) + +(** By default, literals in types [positive], [N], [Z] are parsed and + printed via the [Numeral Notation] command, by conversion from/to + the [Decimal.int] representation. When working with numbers with + thousands of digits and more, conversion from/to [Decimal.int] can + become significantly slow. If that becomes a problem for your + development, this file provides some alternative [Numeral + Notation] commmands that use [Z] as bridge type. To enable these + commands, just be sure to [Require] this file after other files + defining numeral notations. + + Note: up to Coq 8.8, literals in types [positive], [N], [Z] were + parsed and printed using a native ML library of arbitrary + precision integers named bigint.ml. From 8.9, the default is to + parse and print using a Coq library converting sequences of + digits, hence reducing the amount of ML code to trust. But this + method is slower. This file then gives access to the legacy + method, trading efficiency against a larger ML trust base relying + on bigint.ml. *) + +Require Import BinNums. + +(** [positive] *) + +Definition pos_of_z z := + match z with + | Zpos p => Some p + | _ => None + end. + +Definition pos_to_z p := Zpos p. + +Numeral Notation positive pos_of_z pos_to_z : positive_scope. + +(** [N] *) + +Definition n_of_z z := + match z with + | Z0 => Some N0 + | Zpos p => Some (Npos p) + | Zneg _ => None + end. + +Definition n_to_z n := + match n with + | N0 => Z0 + | Npos p => Zpos p + end. + +Numeral Notation N n_of_z n_to_z : N_scope. + +(** [Z] *) + +Definition z_of_z (z:Z) := z. + +Numeral Notation Z z_of_z z_of_z : Z_scope. diff --git a/theories/Numbers/BinNums.v b/theories/Numbers/BinNums.v index d5eb4f2681..3ba9d1f5ed 100644 --- a/theories/Numbers/BinNums.v +++ b/theories/Numbers/BinNums.v @@ -12,15 +12,11 @@ Set Implicit Arguments. -Declare ML Module "positive_syntax_plugin". -Declare ML Module "n_syntax_plugin". -Declare ML Module "z_syntax_plugin". - (** [positive] is a datatype representing the strictly positive integers in a binary way. Starting from 1 (represented by [xH]), one can add a new least significant digit via [xO] (digit 0) or [xI] (digit 1). - Numbers in [positive] can also be denoted using a decimal notation; - e.g. [6%positive] abbreviates [xO (xI xH)] *) + Numbers in [positive] will also be denoted using a decimal notation; + e.g. [6%positive] will abbreviate [xO (xI xH)] *) Inductive positive : Set := | xI : positive -> positive @@ -34,8 +30,8 @@ Arguments xI _%positive. (** [N] is a datatype representing natural numbers in a binary way, by extending the [positive] datatype with a zero. - Numbers in [N] can also be denoted using a decimal notation; - e.g. [6%N] abbreviates [Npos (xO (xI xH))] *) + Numbers in [N] will also be denoted using a decimal notation; + e.g. [6%N] will abbreviate [Npos (xO (xI xH))] *) Inductive N : Set := | N0 : N @@ -49,8 +45,8 @@ Arguments Npos _%positive. An integer is either zero or a strictly positive number (coded as a [positive]) or a strictly negative number (whose opposite is stored as a [positive] value). - Numbers in [Z] can also be denoted using a decimal notation; - e.g. [(-6)%Z] abbreviates [Zneg (xO (xI xH))] *) + Numbers in [Z] will also be denoted using a decimal notation; + e.g. [(-6)%Z] will abbreviate [Zneg (xO (xI xH))] *) Inductive Z : Set := | Z0 : Z diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v index bd4f0279d4..ec480bb1eb 100644 --- a/theories/Numbers/Cyclic/Int31/Cyclic31.v +++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v @@ -23,8 +23,6 @@ Require Import Zpow_facts. Require Import CyclicAxioms. Require Import ROmega. -Declare ML Module "int31_syntax_plugin". - Local Open Scope nat_scope. Local Open Scope int31_scope. @@ -128,7 +126,7 @@ Section Basics. Lemma nshiftl_S_tail : forall n x, nshiftl x (S n) = nshiftl (shiftl x) n. - Proof. + Proof. intros n; elim n; simpl; intros; now f_equal. Qed. diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v index 9f8da831d8..39af62c32f 100644 --- a/theories/Numbers/Cyclic/Int31/Int31.v +++ b/theories/Numbers/Cyclic/Int31/Int31.v @@ -15,6 +15,8 @@ Require Import Wf_nat. Require Export ZArith. Require Export DoubleType. +Declare ML Module "int31_syntax_plugin". + (** * 31-bit integers *) (** This file contains basic definitions of a 31-bit integer diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v index 000d895e10..dcaae1606d 100644 --- a/theories/PArith/BinPos.v +++ b/theories/PArith/BinPos.v @@ -1871,6 +1871,8 @@ Bind Scope positive_scope with Pos.t positive. (** Exportation of notations *) +Numeral Notation positive Pos.of_int Pos.to_uint : positive_scope. + Infix "+" := Pos.add : positive_scope. Infix "-" := Pos.sub : positive_scope. Infix "*" := Pos.mul : positive_scope. diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v index 070314746a..7f30733559 100644 --- a/theories/PArith/BinPosDef.v +++ b/theories/PArith/BinPosDef.v @@ -26,6 +26,8 @@ Require Export BinNums. for the number 6 (which is 110 in binary notation). *) +Local Notation "1" := xH. + Notation "p ~ 1" := (xI p) (at level 7, left associativity, format "p '~' '1'") : positive_scope. Notation "p ~ 0" := (xO p) @@ -325,14 +327,14 @@ Definition sqrtrem_step (f g:positive->positive) p := let r' := g (f r) in if s' <=? r' then (s~1, sub_mask r' s') else (s~0, IsPos r') - | (s,_) => (s~0, sub_mask (g (f 1)) 4) + | (s,_) => (s~0, sub_mask (g (f 1)) 1~0~0) end. Fixpoint sqrtrem p : positive * mask := match p with | 1 => (1,IsNul) - | 2 => (1,IsPos 1) - | 3 => (1,IsPos 2) + | 1~0 => (1,IsPos 1) + | 1~1 => (1,IsPos 1~0) | p~0~0 => sqrtrem_step xO xO (sqrtrem p) | p~0~1 => sqrtrem_step xO xI (sqrtrem p) | p~1~0 => sqrtrem_step xI xO (sqrtrem p) @@ -614,4 +616,9 @@ Definition to_uint p := Decimal.rev (to_little_uint p). Definition to_int n := Decimal.Pos (to_uint n). +Numeral Notation positive of_int to_uint : positive_scope. + End Pos. + +(** Re-export the notation for those who just [Import BinPosDef] *) +Numeral Notation positive Pos.of_int Pos.to_uint : positive_scope. diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index cf7397b57e..a11d491a8b 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -1248,6 +1248,8 @@ Bind Scope Z_scope with Z.t Z. (** Re-export Notations *) +Numeral Notation Z Z.of_int Z.to_int : Z_scope. + Infix "+" := Z.add : Z_scope. Notation "- x" := (Z.opp x) : Z_scope. Infix "-" := Z.sub : Z_scope. diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v index db4de0b90c..8cb62622db 100644 --- a/theories/ZArith/BinIntDef.v +++ b/theories/ZArith/BinIntDef.v @@ -14,6 +14,10 @@ Require Import BinPos BinNat. Local Open Scope Z_scope. +Local Notation "0" := Z0. +Local Notation "1" := (Zpos 1). +Local Notation "2" := (Zpos 2). + (***********************************************************) (** * Binary Integers, Definitions of Operations *) (***********************************************************) @@ -53,7 +57,7 @@ Definition succ_double x := Definition pred_double x := match x with - | 0 => -1 + | 0 => neg 1 | neg p => neg p~1 | pos p => pos (Pos.pred_double p) end. @@ -104,7 +108,7 @@ Definition succ x := x + 1. (** ** Predecessor *) -Definition pred x := x + -1. +Definition pred x := x + neg 1. (** ** Subtraction *) @@ -171,7 +175,7 @@ Definition sgn z := match z with | 0 => 0 | pos p => 1 - | neg p => -1 + | neg p => neg 1 end. (** Boolean equality and comparisons *) @@ -635,4 +639,9 @@ Definition lxor a b := | neg a, neg b => of_N (N.lxor (Pos.pred_N a) (Pos.pred_N b)) end. +Numeral Notation Z of_int to_int : Z_scope. + End Z. + +(** Re-export the notation for those who just [Import BinIntDef] *) +Numeral Notation Z Z.of_int Z.to_int : Z_scope. 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_dune.ml b/tools/coq_dune.ml new file mode 100644 index 0000000000..c89c78c8ec --- /dev/null +++ b/tools/coq_dune.ml @@ -0,0 +1,283 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +(* LICENSE NOTE: This file is dually MIT/LGPL 2.1+ licensed. MIT license: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * in the Software without restriction, including without limitation the rights + * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + * copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in all + * copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + * SOFTWARE. + *) + +(* coq_dune: generate dune build rules for .vo files *) +(* *) +(* At some point this file will become a Dune plugin, so it is very *) +(* important that this file can be bootstrapped with: *) +(* *) +(* ocamlfind ocamlopt -linkpkg -package str coq_dune.ml -o coq_dune *) + +open Format + +(* Keeping this file self-contained as it is a "bootstrap" utility *) +(* Is OCaml missing these basic functions in the stdlib? *) +module Aux = struct + + let option_iter f o = match o with + | Some x -> f x + | None -> () + + let option_cata d f o = match o with + | Some x -> f x + | None -> d + + let list_compare f = let rec lc x y = match x, y with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | x::xs, y::ys -> let r = f x y in if r = 0 then lc xs ys else r + in lc + + let rec pp_list pp sep fmt l = match l with + | [] -> () + | [l] -> fprintf fmt "%a" pp l + | x::xs -> fprintf fmt "%a%a%a" pp x sep () (pp_list pp sep) xs + + let rec pmap f l = match l with + | [] -> [] + | x :: xs -> + begin match f x with + | None -> pmap f xs + | Some r -> r :: pmap f xs + end + + let sep fmt () = fprintf fmt "@;" + + module DirOrd = struct + type t = string list + let compare = list_compare String.compare + end + + module DirMap = Map.Make(DirOrd) + + (* Functions available in newer OCaml versions *) + module Legacy = struct + + (* Slower version of DirMap.update, waiting for OCaml 4.06.0 *) + let dirmap_update key f map = + match begin + try f (Some (DirMap.find key map)) + with Not_found -> f None + end with + | None -> DirMap.remove key map + | Some x -> DirMap.add key x map + + (* Available in OCaml >= 4.04 *) + let split_on_char sep s = + let open String in + let r = ref [] in + let j = ref (length s) in + for i = length s - 1 downto 0 do + if unsafe_get s i = sep then begin + r := sub s (i + 1) (!j - i - 1) :: !r; + j := i + end + done; + sub s 0 !j :: !r + end + + let add_map_list key elem map = + (* Move to Dirmap.update once we require OCaml >= 4.06.0 *) + Legacy.dirmap_update key (fun l -> Some (option_cata [elem] (fun ll -> elem :: ll) l)) map + +end + +open Aux + +(* Once this is a Dune plugin the flags will be taken from the env *) +module Options = struct + + type flag = { + enabled : bool; + cmd : string; + } + + let all_opts = + [ { enabled = false; cmd = "-debug"; } + ; { enabled = false; cmd = "-native_compiler"; } + ] + + let build_coq_flags () = + let popt o = if o.enabled then Some o.cmd else None in + String.concat " " @@ pmap popt all_opts +end + +type vodep = { + target: string; + deps : string list; +} + +type ldep = | VO of vodep | ML4 of string | MLG of string +type ddir = ldep list DirMap.t + +(* Filter `.vio` etc... *) +let filter_no_vo = + List.filter (fun f -> Filename.check_suffix f ".vo") + +(* We could have coqdep to output dune files directly *) + +(* Fix once we move to OCaml >= 4.06.0 *) +let list_init len f = + let rec init_aux i n f = + if i >= n then [] + else let r = f i in r :: init_aux (i+1) n f + in init_aux 0 len f + +let gen_sub n = + (* Move to List.init once we can depend on OCaml >= 4.06.0 *) + String.concat "/" (list_init n (fun _ -> "..")) ^ "/" + +let pp_rule fmt targets deps action = + (* Special printing of the first rule *) + let ppl = pp_list pp_print_string sep in + let pp_deps fmt l = match l with + | [] -> + () + | x :: xs -> + fprintf fmt "(:pp-file %s)%a" x sep (); + pp_list pp_print_string sep fmt xs + in + fprintf fmt + "@[(rule@\n @[(targets @[%a@])@\n(deps @[%a@])@\n(action @[%a@])@])@]@\n" + ppl targets pp_deps deps pp_print_string action + +(* Generate the dune rule: *) +let pp_vo_dep dir fmt vo = + let depth = List.length dir in + let sdir = gen_sub depth in + (* All files except those in Init implicitly depend on the Prelude, we account for it here. *) + let eflag, edep = if List.tl dir = ["Init"] then "-noinit -R theories Coq", [] else "", ["theories/Init/Prelude.vo"] in + (* Coq flags *) + let cflag = Options.build_coq_flags () in + (* Correct path from global to local "theories/Init/Decimal.vo" -> "../../theories/Init/Decimal.vo" *) + let deps = List.map (fun s -> sdir ^ s) (edep @ vo.deps) in + (* The source file is also corrected as we will call coqtop from the top dir *) + let source = String.concat "/" dir ^ "/" ^ Filename.(remove_extension vo.target) ^ ".v" in + (* The final build rule *) + let action = sprintf "(chdir %%{project_root} (run coqtop -boot %s %s -compile %s))" eflag cflag source in + pp_rule fmt [vo.target] deps action + +let pp_ml4_dep _dir fmt ml = + let target = Filename.(remove_extension ml) ^ ".ml" in + let ml4_rule = "(run coqp5 -loc loc -impl %{pp-file} -o %{targets})" in + pp_rule fmt [target] [ml] ml4_rule + +let pp_mlg_dep _dir fmt ml = + let target = Filename.(remove_extension ml) ^ ".ml" in + let ml4_rule = "(run coqpp %{pp-file})" in + pp_rule fmt [target] [ml] ml4_rule + +let pp_dep dir fmt oo = match oo with + | VO vo -> pp_vo_dep dir fmt vo + | ML4 f -> pp_ml4_dep dir fmt f + | MLG f -> pp_mlg_dep dir fmt f + +let out_install fmt dir ff = + let itarget = String.concat "/" dir in + let ff = pmap (function | VO vo -> Some vo.target | _ -> None) ff in + let pp_ispec fmt tg = fprintf fmt "(%s as %s)" tg (itarget^"/"^tg) in + fprintf fmt "(install@\n @[(section lib)@\n(files @[%a@])@])@\n" + (pp_list pp_ispec sep) ff + +(* For each directory, we must record two things, the build rules and + the install specification. *) +let record_dune d ff = + let sd = String.concat "/" d in + if Sys.file_exists sd && Sys.is_directory sd then + let out = open_out (sd^"/dune") in + let fmt = formatter_of_out_channel out in + if List.nth d 0 = "plugins" then + fprintf fmt "(include plugin_base.dune)@\n"; + out_install fmt d ff; + List.iter (pp_dep d fmt) ff; + fprintf fmt "%!"; + close_out out + else + eprintf "error in coq_dune, a directory disappeared: %s@\n%!" sd + +(* File Scanning *) +let choose_ml4g_form f = + if Filename.check_suffix f ".ml4" then ML4 f + else MLG f + +let scan_mlg4 m d = + let dir = ["plugins"; d] in + let m = DirMap.add dir [] m in + let ml4 = Sys.(List.filter (fun f -> Filename.(check_suffix f ".ml4" || check_suffix f ".mlg")) + Array.(to_list @@ readdir String.(concat "/" dir))) in + List.fold_left (fun m f -> add_map_list ["plugins"; d] (choose_ml4g_form f) m) m ml4 + +let scan_plugins m = + let dirs = Sys.(List.filter (fun f -> is_directory @@ "plugins/"^f) Array.(to_list @@ readdir "plugins/")) in + List.fold_left scan_mlg4 m dirs + +(* Process .vfiles.d and generate a skeleton for the dune file *) +let parse_coqdep_line l = + match Str.(split (regexp ":") l) with + | [targets;deps] -> + let targets = Str.(split (regexp "[ \t]+") targets) in + let deps = Str.(split (regexp "[ \t]+") deps) in + let targets = filter_no_vo targets in + begin match targets with + | [target] -> + let dir, target = Filename.(dirname target, basename target) in + Some (Legacy.split_on_char '/' dir, VO { target; deps; }) + (* Otherwise a vio file, we ignore *) + | _ -> None + end + (* Strange rule, we ignore *) + | _ -> None + +let rec read_vfiles ic map = + try + let rule = parse_coqdep_line (input_line ic) in + (* Add vo_entry to its corresponding map entry *) + let map = option_cata map (fun (dir, vo) -> add_map_list dir vo map) rule in + read_vfiles ic map + with End_of_file -> map + +let out_map map = + DirMap.iter record_dune map + +let exec_ifile f = + match Array.length Sys.argv with + | 1 -> f stdin + | 2 -> + let ic = open_in Sys.argv.(1) in + (try f ic with _ -> close_in ic) + | _ -> eprintf "Error: wrong number of arguments@\n%!"; exit 1 + +let _ = + exec_ifile (fun ic -> + let map = scan_plugins DirMap.empty in + let map = read_vfiles ic map in + out_map map) 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/dune b/tools/dune new file mode 100644 index 0000000000..2ba0e3fe8a --- /dev/null +++ b/tools/dune @@ -0,0 +1,31 @@ +(executable + (name coqc) + (public_name coqc) + (modules coqc) + (libraries coq.toplevel)) + +(executable + (name coq_makefile) + (public_name coq_makefile) + (modules coq_makefile) + (libraries coq.lib)) + +(executable + (name coqdep) + (public_name coqdep) + (modules coqdep_lexer coqdep_common coqdep) + (libraries coq.lib)) + +(ocamllex coqdep_lexer) + +(executable + (name coq_tex) + (public_name coq_tex) + (modules coq_tex) + (libraries str)) + +(executable + (name coq_dune) + (public_name coq_dune) + (modules coq_dune) + (libraries str)) diff --git a/topbin/dune b/topbin/dune new file mode 100644 index 0000000000..e89f6c4b13 --- /dev/null +++ b/topbin/dune @@ -0,0 +1,25 @@ +(executable + (name coqtop_bin) + (public_name coqtop) + (package coq) + (modules coqtop_bin) + (libraries coq.toplevel) + (link_flags -linkall)) + +(executable + (name coqtop_byte_bin) + (public_name coqtop.byte) + (package coq) + (modules coqtop_byte_bin) + (libraries compiler-libs.toplevel coq.toplevel) + (modes byte) + (link_flags -linkall)) + +; Workers +(executables + (names coqqueryworker_bin coqtacticworker_bin coqproofworker_bin) + (public_names coqqueryworker.opt coqtacticworker.opt coqproofworker.opt) + (package coq) + (modules :standard \ coqtop_byte_bin coqtop_bin) + (libraries coq.toplevel) + (link_flags -linkall)) diff --git a/toplevel/coqargs.ml b/toplevel/coqargs.ml index 113ba3684c..98a28bb2b6 100644 --- a/toplevel/coqargs.ml +++ b/toplevel/coqargs.ml @@ -154,7 +154,7 @@ let add_compat_require opts v = match v with | Flags.V8_6 -> add_vo_require opts "Coq.Compat.Coq86" None (Some false) | Flags.V8_7 -> add_vo_require opts "Coq.Compat.Coq87" None (Some false) - | Flags.Current -> opts + | Flags.Current -> add_vo_require opts "Coq.Compat.Coq88" None (Some false) let set_batch_mode opts = Flags.quiet := true; diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml index 9e16b97608..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,8 +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 - let dproof = Stm.get_prev_proof ~doc:state.doc (Stm.get_current_state ~doc:state.doc) in - top_goal_print dproof 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/toplevel/dune b/toplevel/dune new file mode 100644 index 0000000000..f51e50aaa3 --- /dev/null +++ b/toplevel/dune @@ -0,0 +1,13 @@ +(library + (name toplevel) + (public_name coq.toplevel) + (synopsis "Coq's Interactive Shell [terminal-based]") + (wrapped false) + (libraries num coq.stm)) +; Coqlevel provides the `Num` library to plugins, we could also use +; -linkall in the plugins file, to be discussed. + +(rule + (targets g_toplevel.ml) + (deps (:mlg-file g_toplevel.mlg)) + (action (run coqpp %{mlg-file}))) diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml index ad1ffa35a1..716c40dbff 100644 --- a/vernac/comInductive.ml +++ b/vernac/comInductive.ml @@ -326,6 +326,15 @@ let check_param = function | CLocalPattern {CAst.loc} -> Loc.raise ?loc (Stream.Error "pattern with quote not allowed here") +let restrict_inductive_universes sigma ctx_params arities constructors = + let merge_universes_of_constr c = + Univ.LSet.union (EConstr.universes_of_constr sigma (EConstr.of_constr c)) in + let uvars = Univ.LSet.empty in + let uvars = Context.Rel.(fold_outside (Declaration.fold_constr merge_universes_of_constr) ctx_params ~init:uvars) in + let uvars = List.fold_right merge_universes_of_constr arities uvars in + let uvars = List.fold_right (fun (_,ctypes,_) -> List.fold_right merge_universes_of_constr ctypes) constructors uvars in + Evd.restrict_universe_context sigma uvars + let interp_mutual_inductive_gen env0 (uparamsl,paramsl,indl) notations cum poly prv finite = check_all_names_different indl; List.iter check_param paramsl; @@ -400,6 +409,7 @@ let interp_mutual_inductive_gen env0 (uparamsl,paramsl,indl) notations cum poly let arities = List.map nf arities in let constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf cl,impsl)) constructors in let ctx_params = List.map Termops.(map_rel_decl (EConstr.to_constr sigma)) ctx_params in + let sigma = restrict_inductive_universes sigma ctx_params arities constructors in let uctx = Evd.check_univ_decl ~poly sigma decl in List.iter (fun c -> check_evars env_params (Evd.from_env env_params) sigma (EConstr.of_constr c)) arities; Context.Rel.iter (fun c -> check_evars env0 (Evd.from_env env0) sigma (EConstr.of_constr c)) ctx_params; diff --git a/vernac/dune b/vernac/dune new file mode 100644 index 0000000000..45b567d631 --- /dev/null +++ b/vernac/dune @@ -0,0 +1,16 @@ +(library + (name vernac) + (synopsis "Coq's Vernacular Language") + (public_name coq.vernac) + (wrapped false) + (libraries tactics parsing)) + +(rule + (targets g_proofs.ml) + (deps (:mlg-file g_proofs.mlg)) + (action (run coqpp %{mlg-file}))) + +(rule + (targets g_vernac.ml) + (deps (:mlg-file g_vernac.mlg)) + (action (run coqpp %{mlg-file}))) diff --git a/vernac/himsg.ml b/vernac/himsg.ml index b9c47ff475..a4650cfd92 100644 --- a/vernac/himsg.ml +++ b/vernac/himsg.ml @@ -679,6 +679,11 @@ let explain_unsatisfied_constraints env sigma cst = Univ.pr_constraints (Termops.pr_evd_level sigma) cst ++ spc () ++ str "(maybe a bugged tactic)." +let explain_undeclared_universe env sigma l = + strbrk "Undeclared universe: " ++ + Termops.pr_evd_level sigma l ++ + spc () ++ str "(maybe a bugged tactic)." + let explain_type_error env sigma err = let env = make_all_name_different env sigma in match err with @@ -716,6 +721,8 @@ let explain_type_error env sigma err = explain_wrong_case_info env ind ci | UnsatisfiedConstraints cst -> explain_unsatisfied_constraints env sigma cst + | UndeclaredUniverse l -> + explain_undeclared_universe env sigma l let pr_position (cl,pos) = let clpos = match cl with @@ -1299,6 +1306,7 @@ let map_ptype_error f = function | IllTypedRecBody (n, na, jv, t) -> IllTypedRecBody (n, na, Array.map (on_judgment f) jv, Array.map f t) | UnsatisfiedConstraints g -> UnsatisfiedConstraints g +| UndeclaredUniverse l -> UndeclaredUniverse l let explain_reduction_tactic_error = function | Tacred.InvalidAbstraction (env,sigma,c,(env',e)) -> diff --git a/vernac/lemmas.ml b/vernac/lemmas.ml index ce74f2344a..880a11becd 100644 --- a/vernac/lemmas.ml +++ b/vernac/lemmas.ml @@ -71,17 +71,13 @@ let adjust_guardness_conditions const = function List.interval 0 (List.length ((lam_assum c)))) lemma_guard (Array.to_list fixdefs) in *) - let add c cb e = - let exists c e = - try ignore(Environ.lookup_constant c e); true - with Not_found -> false in - if exists c e then e else Environ.add_constant c cb e in - let env = List.fold_left (fun env { eff } -> - match eff with - | SEsubproof (c, cb,_) -> add c cb env - | SEscheme (l,_) -> - List.fold_left (fun e (_,c,cb,_) -> add c cb e) env l) - env (Safe_typing.side_effects_of_private_constants eff) in + let fold env eff = + try + let _ = Environ.lookup_constant eff.seff_constant env in + env + with Not_found -> Environ.add_constant eff.seff_constant eff.seff_body env + in + let env = List.fold_left fold env (Safe_typing.side_effects_of_private_constants eff) in let indexes = search_guard env possible_indexes fixdecls in diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 41586eed8b..f7ba305374 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -1505,8 +1505,8 @@ let _ = { optdepr = false; optname = "kernel term sharing"; optkey = ["Kernel"; "Term"; "Sharing"]; - optread = (fun () -> !CClosure.share); - optwrite = (fun b -> CClosure.share := b) } + optread = (fun () -> (Global.typing_flags ()).Declarations.share_reduction); + optwrite = (fun b -> Global.set_reduction_sharing b) } let _ = declare_bool_option |