diff options
307 files changed, 5696 insertions, 4568 deletions
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 9b208f5a24..b1709e1921 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -19,7 +19,7 @@ stages: variables: # Format: $IMAGE-V$DATE [Cache is not used as of today but kept here # for reference] - CACHEKEY: "bionic_coq-V2020-09-17-V88" + CACHEKEY: "bionic_coq-V2020-10-12-V89" IMAGE: "$CI_REGISTRY_IMAGE:$CACHEKEY" # By default, jobs run in the base switch; override to select another switch OPAM_SWITCH: "base" diff --git a/Makefile.build b/Makefile.build index eed3c2813a..526a8c5831 100644 --- a/Makefile.build +++ b/Makefile.build @@ -401,6 +401,12 @@ kernel/uint63.ml: kernel/uint63_$(OCAML_INT_SIZE).ml rm -f $@ && cp $< $@ && chmod a-w $@ ########################################################################### +# Specific rules for Float64 +########################################################################### +kernel/float64.ml: kernel/float64_$(OCAML_INT_SIZE).ml + rm -f $@ && cp $< $@ && chmod a-w $@ + +########################################################################### # Main targets (coqtop.opt, coqtop.byte) ########################################################################### diff --git a/Makefile.make b/Makefile.make index 51d6d1c3c1..34f5707ae8 100644 --- a/Makefile.make +++ b/Makefile.make @@ -107,7 +107,7 @@ GRAMMLIFILES := $(addsuffix .mli, $(GRAMFILES)) GENGRAMMLFILES := $(GRAMMLFILES) gramlib/.pack/gramlib.ml # why is gramlib.ml not in GRAMMLFILES? GENMLGFILES:= $(MLGFILES:.mlg=.ml) -GENMLFILES:=$(LEXFILES:.mll=.ml) $(YACCFILES:.mly=.ml) $(GENMLGFILES) $(GENGRAMMLFILES) ide/coqide/coqide_os_specific.ml kernel/vmopcodes.ml kernel/uint63.ml +GENMLFILES:=$(LEXFILES:.mll=.ml) $(YACCFILES:.mly=.ml) $(GENMLGFILES) $(GENGRAMMLFILES) ide/coqide/coqide_os_specific.ml kernel/vmopcodes.ml kernel/uint63.ml kernel/float64.ml GENMLIFILES:=$(GRAMMLIFILES) GENHFILES:=kernel/byterun/coq_instruct.h kernel/byterun/coq_jumptbl.h GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES) kernel/genOpcodeFiles.exe diff --git a/clib/cString.ml b/clib/cString.ml index dcada4c18f..9d2c3729b2 100644 --- a/clib/cString.ml +++ b/clib/cString.ml @@ -25,6 +25,7 @@ sig val ordinal : int -> string val is_sub : string -> string -> int -> bool val is_prefix : string -> string -> bool + val is_suffix : string -> string -> bool module Set : Set.S with type elt = t module Map : CMap.ExtS with type key = t and module Set := Set module List : CList.MonoS with type elt = t @@ -105,6 +106,9 @@ let is_sub p s off = let is_prefix p s = is_sub p s 0 +let is_suffix p s = + is_sub p s (String.length s - String.length p) + let plural n s = if n<>1 then s^"s" else s let conjugate_verb_to_be n = if n<>1 then "are" else "is" diff --git a/clib/cString.mli b/clib/cString.mli index 0f78e66573..be8a202b64 100644 --- a/clib/cString.mli +++ b/clib/cString.mli @@ -54,6 +54,9 @@ sig val is_prefix : string -> string -> bool (** [is_prefix p s] tests whether [p] is a prefix of [s]. *) + val is_suffix : string -> string -> bool + (** [is_suffix suf s] tests whether [suf] is a suffix of [s]. *) + (** {6 Generic operations} **) module Set : Set.S with type elt = t diff --git a/default.nix b/default.nix index ffee77f1f7..7f9e62b28c 100644 --- a/default.nix +++ b/default.nix @@ -43,7 +43,6 @@ stdenv.mkDerivation rec { hostname python3 time # coq-makefile timing tools ] - ++ (with ocamlPackages; [ ocaml findlib ]) ++ optionals buildIde [ ocamlPackages.lablgtk3-sourceview3 glib gnome3.defaultIconTheme wrapGAppsHook @@ -69,10 +68,13 @@ stdenv.mkDerivation rec { ++ [ dune_2 ] # Maybe the next build system ); - # Since #12604, ocamlfind looks for num when building plugins + # OCaml and findlib are needed so that native_compute works + # This follows a similar change in the nixpkgs repo (cf. NixOS/nixpkgs#101058) + # ocamlfind looks for zarith when building plugins # This follows a similar change in the nixpkgs repo (cf. NixOS/nixpkgs#94230) - # Same for zarith which is needed since its introduction as a dependency of Coq - propagatedBuildInputs = with ocamlPackages; [ zarith ]; + propagatedBuildInputs = with ocamlPackages; [ ocaml findlib zarith ]; + + propagatedUserEnvPkgs = with ocamlPackages; [ ocaml findlib ]; src = if shell then null diff --git a/dev/bench/gitlab-bench.yml b/dev/bench/gitlab-bench.yml index 4275e3d121..25545cf565 100644 --- a/dev/bench/gitlab-bench.yml +++ b/dev/bench/gitlab-bench.yml @@ -11,18 +11,6 @@ bench: - timing variables: GIT_DEPTH: "" - coq_pr_number: "" - coq_pr_comment_id: "" - new_ocaml_switch: "ocaml-base-compiler.4.07.1" - old_ocaml_switch: "ocaml-base-compiler.4.07.1" - new_coq_repository: "https://gitlab.com/coq/coq.git" - old_coq_repository: "https://gitlab.com/coq/coq.git" - new_coq_opam_archive_git_uri: "https://github.com/coq/opam-coq-archive.git" - old_coq_opam_archive_git_uri: "https://github.com/coq/opam-coq-archive.git" - new_coq_opam_archive_git_branch: "master" - old_coq_opam_archive_git_branch: "master" - num_of_iterations: 1 - coq_opam_packages: "coq-performance-tests-lite coq-engine-bench-lite coq-hott coq-bignums coq-mathcomp-ssreflect coq-mathcomp-fingroup coq-mathcomp-algebra coq-mathcomp-solvable coq-mathcomp-field coq-mathcomp-character coq-mathcomp-odd-order coq-math-classes coq-corn coq-flocq coq-compcert coq-geocoq coq-color coq-coqprime coq-coqutil coq-bedrock2 coq-rewriter coq-fiat-core coq-fiat-parsers coq-fiat-crypto coq-unimath coq-sf-plf coq-coquelicot coq-lambda-rust coq-verdi coq-verdi-raft coq-fourcolor coq-rewriter-perf-SuperFast" artifacts: name: "$CI_JOB_NAME" paths: diff --git a/dev/bench/gitlab.sh b/dev/bench/gitlab.sh index 7625e4e7f7..d2e150be9a 100755 --- a/dev/bench/gitlab.sh +++ b/dev/bench/gitlab.sh @@ -40,18 +40,19 @@ echo $PWD #check_variable "JOB_NAME" #check_variable "JENKINS_URL" check_variable "CI_JOB_URL" -check_variable "coq_pr_number" -check_variable "coq_pr_comment_id" -check_variable "new_ocaml_switch" -check_variable "new_coq_repository" -check_variable "new_coq_opam_archive_git_uri" -check_variable "new_coq_opam_archive_git_branch" -check_variable "old_ocaml_switch" -check_variable "old_coq_repository" -check_variable "old_coq_opam_archive_git_uri" -check_variable "old_coq_opam_archive_git_branch" -check_variable "num_of_iterations" -check_variable "coq_opam_packages" + +: "${coq_pr_number:=}" +: "${coq_pr_comment_id:=}" +: "${new_ocaml_switch:=ocaml-base-compiler.4.07.1}" +: "${old_ocaml_switch:=ocaml-base-compiler.4.07.1}" +: "${new_coq_repository:=https://gitlab.com/coq/coq.git}" +: "${old_coq_repository:=https://gitlab.com/coq/coq.git}" +: "${new_coq_opam_archive_git_uri:=https://github.com/coq/opam-coq-archive.git}" +: "${old_coq_opam_archive_git_uri:=https://github.com/coq/opam-coq-archive.git}" +: "${new_coq_opam_archive_git_branch:=master}" +: "${old_coq_opam_archive_git_branch:=master}" +: "${num_of_iterations:=1}" +: "${coq_opam_packages:=coq-performance-tests-lite coq-engine-bench-lite coq-hott coq-bignums coq-mathcomp-ssreflect coq-mathcomp-fingroup coq-mathcomp-algebra coq-mathcomp-solvable coq-mathcomp-field coq-mathcomp-character coq-mathcomp-odd-order coq-math-classes coq-corn coq-flocq coq-compcert coq-geocoq coq-color coq-coqprime coq-coqutil coq-bedrock2 coq-rewriter coq-fiat-core coq-fiat-parsers coq-fiat-crypto coq-unimath coq-sf-plf coq-coquelicot coq-lambda-rust coq-verdi coq-verdi-raft coq-fourcolor coq-rewriter-perf-SuperFast}" new_coq_commit=$(git rev-parse HEAD^2) old_coq_commit=$(git merge-base HEAD^1 $new_coq_commit) @@ -428,6 +429,9 @@ for coq_opam_package in $sorted_coq_opam_packages; do new_base_path=$new_ocaml_switch/.opam-switch/build/$coq_opam_package.dev*/ old_base_path=$old_ocaml_switch/.opam-switch/build/$coq_opam_package.dev*/ for vo in `cd $new_opam_root/$new_base_path/; find -name '*.vo'`; do + if [ -e $old_opam_root/$old_base_path/$vo ]; then + echo "$coq_opam_package/$vo $(stat -c%s $old_opam_root/$old_base_path/$vo) $(stat -c%s $new_opam_root/$new_base_path/$vo)" >> "$log_dir/vosize.log" + fi if [ -e $old_opam_root/$old_base_path/${vo%%o}.timing -a \ -e $new_opam_root/$new_base_path/${vo%%o}.timing ]; then mkdir -p $working_dir/html/$coq_opam_package/`dirname $vo`/ diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh index fcc585117b..fc8921e63d 100755 --- a/dev/build/windows/makecoq_mingw.sh +++ b/dev/build/windows/makecoq_mingw.sh @@ -1204,7 +1204,7 @@ function make_elpi { make_dune make_re - if build_prep https://github.com/LPCIC/elpi/archive v1.11.0 tar.gz 1 elpi; then + if build_prep https://github.com/LPCIC/elpi/archive v1.11.4 tar.gz 1 elpi; then log2 dune build -p elpi log2 dune install elpi diff --git a/dev/ci/ci-common.sh b/dev/ci/ci-common.sh index f9187d53a6..b85261d7fc 100644 --- a/dev/ci/ci-common.sh +++ b/dev/ci/ci-common.sh @@ -44,6 +44,18 @@ CI_BUILD_DIR="$PWD/_build_ci" ls -l "$CI_BUILD_DIR" || true +declare -A overlays + +overlay() +{ + local project=$1 + local ov_url=$2 + local ov_ref=$3 + + overlays[${project}_URL]=$ov_url + overlays[${project}_REF]=$ov_ref +} + set +x for overlay in "${ci_dir}"/user-overlays/*.sh; do # shellcheck source=/dev/null @@ -62,32 +74,44 @@ set -x # (local build), it uses git clone to perform the download. git_download() { - local PROJECT=$1 - local DEST="$CI_BUILD_DIR/$PROJECT" - local GITURL_VAR="${PROJECT}_CI_GITURL" - local GITURL="${!GITURL_VAR}" - local REF_VAR="${PROJECT}_CI_REF" - local REF="${!REF_VAR}" - - if [ -d "$DEST" ]; then - echo "Warning: download and unpacking of $PROJECT skipped because $DEST already exists." - elif [ "$FORCE_GIT" = "1" ] || [ "$CI" = "" ]; then - git clone "$GITURL" "$DEST" - cd "$DEST" - git checkout "$REF" + local project=$1 + local dest="$CI_BUILD_DIR/$project" + + local giturl_var="${project}_CI_GITURL" + local giturl="${!giturl_var}" + local ref_var="${project}_CI_REF" + local ref="${!ref_var}" + + local ov_url=${overlays[${project}_URL]} + local ov_ref=${overlays[${project}_REF]} + + if [ -d "$dest" ]; then + echo "Warning: download and unpacking of $project skipped because $dest already exists." + elif [[ $ov_url ]] || [ "$FORCE_GIT" = "1" ] || [ "$CI" = "" ]; then + git clone "$giturl" "$dest" + cd "$dest" + git checkout "$ref" + git log -n 1 + if [[ $ov_url ]]; then + git -c pull.rebase=false -c user.email=nobody@example.invalid -c user.name=Nobody \ + pull --no-ff "$ov_url" "$ov_ref" + git log -n 1 HEAD^2 + git log -n 1 + fi else # When possible, we download tarballs to reduce bandwidth and latency - local ARCHIVEURL_VAR="${PROJECT}_CI_ARCHIVEURL" - local ARCHIVEURL="${!ARCHIVEURL_VAR}" - mkdir -p "$DEST" - cd "$DEST" - local COMMIT=$(git ls-remote "$GITURL" "refs/heads/$REF" | cut -f 1) - if [[ "$COMMIT" == "" ]]; then - # $REF must have been a tag or hash, not a branch - COMMIT="$REF" + local archiveurl_var="${project}_CI_ARCHIVEURL" + local archiveurl="${!archiveurl_var}" + mkdir -p "$dest" + cd "$dest" + local commit + commit=$(git ls-remote "$giturl" "refs/heads/$ref" | cut -f 1) + if [[ "$commit" == "" ]]; then + # $ref must have been a tag or hash, not a branch + commit="$ref" fi - wget "$ARCHIVEURL/$COMMIT.tar.gz" - tar xfz "$COMMIT.tar.gz" --strip-components=1 - rm -f "$COMMIT.tar.gz" + wget "$archiveurl/$commit.tar.gz" + tar xfz "$commit.tar.gz" --strip-components=1 + rm -f "$commit.tar.gz" fi } diff --git a/dev/ci/ci-iris.sh b/dev/ci/ci-iris.sh index 0256906112..9616f3ce00 100755 --- a/dev/ci/ci-iris.sh +++ b/dev/ci/ci-iris.sh @@ -9,13 +9,13 @@ git_download iris_string_ident git_download iris_examples # Extract required version of Iris (avoiding "+" which does not work on MacOS :( *) -iris_CI_REF=$(grep -F '"coq-iris"' < "${CI_BUILD_DIR}/iris_examples/opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') +iris_CI_REF=$(grep -F '"coq-iris"' < "${CI_BUILD_DIR}/iris_examples/coq-iris-examples.opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') # Setup Iris git_download iris # Extract required version of std++ -stdpp_CI_REF=$(grep -F '"coq-stdpp"' < "${CI_BUILD_DIR}/iris/opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') +stdpp_CI_REF=$(grep -F '"coq-stdpp"' < "${CI_BUILD_DIR}/iris/coq-iris.opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') # Setup std++ git_download stdpp diff --git a/dev/ci/docker/bionic_coq/Dockerfile b/dev/ci/docker/bionic_coq/Dockerfile index f672ead807..c17ec502e7 100644 --- a/dev/ci/docker/bionic_coq/Dockerfile +++ b/dev/ci/docker/bionic_coq/Dockerfile @@ -1,4 +1,4 @@ -# CACHEKEY: "bionic_coq-V2020-09-17-V88" +# CACHEKEY: "bionic_coq-V2020-10-12-V89" # ^^ Update when modifying this file. FROM ubuntu:bionic @@ -43,7 +43,7 @@ ENV COMPILER="4.05.0" # Common OPAM packages ENV BASE_OPAM="zarith.1.10 ocamlfind.1.8.1 ounit2.2.2.3 odoc.1.5.1" \ CI_OPAM="menhir.20190626 ocamlgraph.1.8.8" \ - BASE_ONLY_OPAM="elpi.1.11.0" + BASE_ONLY_OPAM="elpi.1.11.4" # BASE switch; CI_OPAM contains Coq's CI dependencies. ENV COQIDE_OPAM="cairo2.0.6.1 lablgtk3-sourceview3.3.1.0" diff --git a/dev/ci/user-overlays/08743-ejgallego-zarith.sh b/dev/ci/user-overlays/08743-ejgallego-zarith.sh deleted file mode 100644 index da1d30c1e9..0000000000 --- a/dev/ci/user-overlays/08743-ejgallego-zarith.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "11742" ] || [ "$CI_BRANCH" = "zarith+core" ]; then - - bignums_CI_REF=zarith - bignums_CI_GITURL=https://github.com/ejgallego/bignums - -fi diff --git a/dev/ci/user-overlays/10390-SkySkimmer-uip.sh b/dev/ci/user-overlays/10390-SkySkimmer-uip.sh deleted file mode 100644 index 80107ac9c5..0000000000 --- a/dev/ci/user-overlays/10390-SkySkimmer-uip.sh +++ /dev/null @@ -1,30 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "10390" ] || [ "$CI_BRANCH" = "uip" ]; then - - unicoq_CI_REF=uip - unicoq_CI_GITURL=https://github.com/SkySkimmer/unicoq - - mtac2_CI_REF=uip - mtac2_CI_GITURL=https://github.com/SkySkimmer/Mtac2 - - elpi_CI_REF=uip - elpi_CI_GITURL=https://github.com/SkySkimmer/coq-elpi - - equations_CI_REF=uip - equations_CI_GITURL=https://github.com/SkySkimmer/Coq-Equations - - paramcoq_CI_REF=uip - paramcoq_CI_GITURL=https://github.com/SkySkimmer/paramcoq - - relation_algebra_CI_REF=uip - relation_algebra_CI_GITURL=https://github.com/SkySkimmer/relation-algebra - - coq_dpdgraph_CI_REF=uip - coq_dpdgraph_CI_GITURL=https://github.com/SkySkimmer/coq-dpdgraph - - coqhammer_CI_REF=uip - coqhammer_CI_GITURL=https://github.com/SkySkimmer/coqhammer - - metacoq_CI_REF=uip - metacoq_CI_GITURL=https://github.com/SkySkimmer/metacoq - -fi diff --git a/dev/ci/user-overlays/11566-ejgallego-exninfo+coercion.sh b/dev/ci/user-overlays/11566-ejgallego-exninfo+coercion.sh deleted file mode 100644 index 05192facbe..0000000000 --- a/dev/ci/user-overlays/11566-ejgallego-exninfo+coercion.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "11566" ] || [ "$CI_BRANCH" = "exninfo+coercion" ]; then - - mtac2_CI_REF=exninfo+coercion - mtac2_CI_GITURL=https://github.com/ejgallego/Mtac2 - -fi diff --git a/dev/ci/user-overlays/11604-persistent-arrays.sh b/dev/ci/user-overlays/11604-persistent-arrays.sh deleted file mode 100644 index aec5c4fa3d..0000000000 --- a/dev/ci/user-overlays/11604-persistent-arrays.sh +++ /dev/null @@ -1,18 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "11604" ] || [ "$CI_BRANCH" = "persistent-arrays" ]; then - - unicoq_CI_REF=persistent-arrays - unicoq_CI_GITURL=https://github.com/maximedenes/unicoq - - elpi_CI_REF=persistent-arrays - elpi_CI_GITURL=https://github.com/maximedenes/coq-elpi - - #relation_algebra_CI_REF=persistent-arrays - #relation_algebra_CI_GITURL=https://github.com/maximedenes/relation-algebra - - coqhammer_CI_REF=persistent-arrays - coqhammer_CI_GITURL=https://github.com/maximedenes/coqhammer - - metacoq_CI_REF=persistent-arrays - metacoq_CI_GITURL=https://github.com/maximedenes/metacoq - -fi diff --git a/dev/ci/user-overlays/11836-ejgallego-obligations+functional.sh b/dev/ci/user-overlays/11836-ejgallego-obligations+functional.sh deleted file mode 100644 index 72ec55a37c..0000000000 --- a/dev/ci/user-overlays/11836-ejgallego-obligations+functional.sh +++ /dev/null @@ -1,18 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "11836" ] || [ "$CI_BRANCH" = "obligations+functional" ]; then - - mtac2_CI_REF=obligations+functional - mtac2_CI_GITURL=https://github.com/ejgallego/Mtac2 - - paramcoq_CI_REF=obligations+functional - paramcoq_CI_GITURL=https://github.com/ejgallego/paramcoq - - equations_CI_REF=obligations+functional - equations_CI_GITURL=https://github.com/ejgallego/Coq-Equations - - metacoq_CI_REF=obligations+functional - metacoq_CI_GITURL=https://github.com/ejgallego/metacoq - - rewriter_CI_REF=obligations+functional - rewriter_CI_GITURL=https://github.com/ejgallego/rewriter - -fi diff --git a/dev/ci/user-overlays/11922-ppedrot-rm-local-reductionops.sh b/dev/ci/user-overlays/11922-ppedrot-rm-local-reductionops.sh deleted file mode 100644 index c9ddb3fb9f..0000000000 --- a/dev/ci/user-overlays/11922-ppedrot-rm-local-reductionops.sh +++ /dev/null @@ -1,9 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "11922" ] || [ "$CI_BRANCH" = "rm-local-reductionops" ]; then - - equations_CI_REF="rm-local-reductionops" - equations_CI_GITURL=https://github.com/ppedrot/Coq-Equations - - unicoq_CI_REF="rm-local-reductionops" - unicoq_CI_GITURL=https://github.com/ppedrot/unicoq - -fi diff --git a/dev/ci/user-overlays/11948-proux01-hexadecimal.sh b/dev/ci/user-overlays/11948-proux01-hexadecimal.sh deleted file mode 100644 index 0b3133d1f1..0000000000 --- a/dev/ci/user-overlays/11948-proux01-hexadecimal.sh +++ /dev/null @@ -1,12 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "11948" ] || [ "$CI_BRANCH" = "hexadecimal" ]; then - - stdlib2_CI_REF=hexadecimal - stdlib2_CI_GITURL=https://github.com/proux01/stdlib2 - - paramcoq_CI_REF=hexadecimal - paramcoq_CI_GITURL=https://github.com/proux01/paramcoq - - metacoq_CI_REF=hexadecimal - metacoq_CI_GITURL=https://github.com/proux01/metacoq - -fi diff --git a/dev/ci/user-overlays/12267-gares-elpi-1.11.sh b/dev/ci/user-overlays/12267-gares-elpi-1.11.sh deleted file mode 100644 index ceb7afe3d1..0000000000 --- a/dev/ci/user-overlays/12267-gares-elpi-1.11.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12267" ] || [ "$CI_BRANCH" = "elpi-1.11" ]; then - - elpi_CI_REF="coq-master+elpi-1.11" - elpi_hb_CI_REF="coq-master+elpi.11" - -fi diff --git a/dev/ci/user-overlays/12372-ejgallego-proof+info.sh b/dev/ci/user-overlays/12372-ejgallego-proof+info.sh deleted file mode 100644 index b9fdc338b5..0000000000 --- a/dev/ci/user-overlays/12372-ejgallego-proof+info.sh +++ /dev/null @@ -1,24 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12372" ] || [ "$CI_BRANCH" = "proof+info" ]; then - - rewriter_CI_REF=proof+info - rewriter_CI_GITURL=https://github.com/ejgallego/rewriter - - paramcoq_CI_REF=proof+info - paramcoq_CI_GITURL=https://github.com/ejgallego/paramcoq - - mtac2_CI_REF=proof+info - mtac2_CI_GITURL=https://github.com/ejgallego/Mtac2 - - equations_CI_REF=proof+info - equations_CI_GITURL=https://github.com/ejgallego/Coq-Equations - - elpi_CI_REF=proof+info - elpi_CI_GITURL=https://github.com/ejgallego/coq-elpi - - aac_tactics_CI_REF=proof+info - aac_tactics_CI_GITURL=https://github.com/ejgallego/aac-tactics - - metacoq_CI_REF=proof+info - metacoq_CI_GITURL=https://github.com/ejgallego/metacoq - -fi diff --git a/dev/ci/user-overlays/12449-SkySkimmer-minim-prop-toset.sh b/dev/ci/user-overlays/12449-SkySkimmer-minim-prop-toset.sh new file mode 100644 index 0000000000..fb5947d218 --- /dev/null +++ b/dev/ci/user-overlays/12449-SkySkimmer-minim-prop-toset.sh @@ -0,0 +1,6 @@ +if [ "$CI_PULL_REQUEST" = "12449" ] || [ "$CI_BRANCH" = "minim-prop-toset" ]; then + + mtac2_CI_REF=janno/coq-12449 + mtac2_CI_GITURL=https://github.com/mtac2/mtac2 + +fi diff --git a/dev/ci/user-overlays/12505-ppedrot-factor-hint-flags.sh b/dev/ci/user-overlays/12505-ppedrot-factor-hint-flags.sh deleted file mode 100644 index ced0d95945..0000000000 --- a/dev/ci/user-overlays/12505-ppedrot-factor-hint-flags.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12505" ] || [ "$CI_BRANCH" = "factor-hint-flags" ]; then - - fiat_parsers_CI_REF="factor-hint-flags" - fiat_parsers_CI_GITURL=https://github.com/ppedrot/fiat - -fi diff --git a/dev/ci/user-overlays/12523-term-notation-custom.sh b/dev/ci/user-overlays/12523-term-notation-custom.sh deleted file mode 100644 index 6217312a2a..0000000000 --- a/dev/ci/user-overlays/12523-term-notation-custom.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12523" ] || [ "$CI_BRANCH" = "fix-11121" ]; then - - equations_CI_REF=fix-11121 - equations_CI_GITURL=https://github.com/maximedenes/Coq-Equations - -fi diff --git a/dev/ci/user-overlays/12565-ppedrot-fix-tc-search-opacity.sh b/dev/ci/user-overlays/12565-ppedrot-fix-tc-search-opacity.sh deleted file mode 100644 index 7c04608403..0000000000 --- a/dev/ci/user-overlays/12565-ppedrot-fix-tc-search-opacity.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12565" ] || [ "$CI_BRANCH" = "fix-tc-search-opacity" ]; then - - coqhammer_CI_REF=fix-tc-search-opacity - coqhammer_CI_GITURL=https://github.com/ppedrot/coqhammer - -fi diff --git a/dev/ci/user-overlays/12599-ppedrot-rm-deprecated-refiner.sh b/dev/ci/user-overlays/12599-ppedrot-rm-deprecated-refiner.sh deleted file mode 100644 index c8c5b3ed5a..0000000000 --- a/dev/ci/user-overlays/12599-ppedrot-rm-deprecated-refiner.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12599" ] || [ "$CI_BRANCH" = "rm-deprecated-refiner" ]; then - - equations_CI_REF=rm-deprecated-refiner - equations_CI_GITURL=https://github.com/ppedrot/Coq-Equations - -fi diff --git a/dev/ci/user-overlays/12650-SkySkimmer-rebuild-record.sh b/dev/ci/user-overlays/12650-SkySkimmer-rebuild-record.sh deleted file mode 100644 index d4c67b03b5..0000000000 --- a/dev/ci/user-overlays/12650-SkySkimmer-rebuild-record.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12650" ] || [ "$CI_BRANCH" = "rebuild-record" ]; then - - elpi_CI_REF=rebuild-record - elpi_CI_GITURL=https://github.com/SkySkimmer/coq-elpi - -fi diff --git a/dev/ci/user-overlays/12709-ppedrot-hint-pattern-out.sh b/dev/ci/user-overlays/12709-ppedrot-hint-pattern-out.sh deleted file mode 100644 index 56a69abbf7..0000000000 --- a/dev/ci/user-overlays/12709-ppedrot-hint-pattern-out.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12709" ] || [ "$CI_BRANCH" = "hint-pattern-out" ]; then - - coqhammer_CI_REF=hint-pattern-out - coqhammer_CI_GITURL=https://github.com/ppedrot/coqhammer - -fi diff --git a/dev/ci/user-overlays/12720-ppedrot-factor-class-hint-clenv.sh b/dev/ci/user-overlays/12720-ppedrot-factor-class-hint-clenv.sh deleted file mode 100644 index e57f95ef19..0000000000 --- a/dev/ci/user-overlays/12720-ppedrot-factor-class-hint-clenv.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12720" ] || [ "$CI_BRANCH" = "factor-class-hint-clenv" ]; then - - coqhammer_CI_REF=factor-class-hint-clenv - coqhammer_CI_GITURL=https://github.com/ppedrot/coqhammer - -fi diff --git a/dev/ci/user-overlays/12756-jashug-dont-refresh-argument-names.sh b/dev/ci/user-overlays/12756-jashug-dont-refresh-argument-names.sh deleted file mode 100644 index 54fdd87566..0000000000 --- a/dev/ci/user-overlays/12756-jashug-dont-refresh-argument-names.sh +++ /dev/null @@ -1,9 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12756" ] || [ "$CI_BRANCH" = "dont-refresh-argument-names" ]; then - - mathcomp_CI_REF=dont-refresh-argument-names-overlay - mathcomp_CI_GITURL=https://github.com/jashug/math-comp - - oddorder_CI_REF=dont-refresh-argument-names-overlay - oddorder_CI_GITURL=https://github.com/jashug/odd-order - -fi diff --git a/dev/ci/user-overlays/12801-VincentSe-CyclicSet.sh b/dev/ci/user-overlays/12801-VincentSe-CyclicSet.sh deleted file mode 100644 index 6a9cf78687..0000000000 --- a/dev/ci/user-overlays/12801-VincentSe-CyclicSet.sh +++ /dev/null @@ -1,8 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12801" ] || [ "$CI_BRANCH" = "CyclicSet" ]; then - - bignums_CI_REF=CyclicSet - bignums_CI_GITURL=https://github.com/VincentSe/bignums - - coqprime_CI_REF=CyclicSet - coqprime_CI_GITURL=https://github.com/VincentSe/coqprime -fi diff --git a/dev/ci/user-overlays/12875-herbelin-master+about-print-all-arguments-names.sh b/dev/ci/user-overlays/12875-herbelin-master+about-print-all-arguments-names.sh deleted file mode 100644 index bb08c13ef3..0000000000 --- a/dev/ci/user-overlays/12875-herbelin-master+about-print-all-arguments-names.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12875" ] || [ "$CI_BRANCH" = "master+about-print-all-arguments-names" ]; then - - elpi_CI_REF=coq-master+adapt-coq12875-arguments-pass-name-impargs - elpi_CI_GITURL=https://github.com/herbelin/coq-elpi - -fi diff --git a/dev/ci/user-overlays/12892-SkySkimmer-update-s-univs.sh b/dev/ci/user-overlays/12892-SkySkimmer-update-s-univs.sh deleted file mode 100644 index f0878202d3..0000000000 --- a/dev/ci/user-overlays/12892-SkySkimmer-update-s-univs.sh +++ /dev/null @@ -1,9 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12892" ] || [ "$CI_BRANCH" = "update-s-univs" ]; then - - elpi_CI_REF=update-s-univs - elpi_CI_GITURL=https://github.com/SkySkimmer/coq-elpi - - equations_CI_REF=update-s-univs - equations_CI_GITURL=https://github.com/SkySkimmer/Coq-Equations - -fi diff --git a/dev/ci/user-overlays/12968-maximedenes-delay-frozen-evarconv.sh b/dev/ci/user-overlays/12968-maximedenes-delay-frozen-evarconv.sh deleted file mode 100644 index ee75944a52..0000000000 --- a/dev/ci/user-overlays/12968-maximedenes-delay-frozen-evarconv.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12968" ] || [ "$CI_BRANCH" = "delay-frozen-evarconv" ]; then - - equations_CI_REF=delay-frozen-evarconv - equations_CI_GITURL=https://github.com/maximedenes/Coq-Equations - -fi diff --git a/dev/ci/user-overlays/12977-ppedrot-static-hint-poly.sh b/dev/ci/user-overlays/12977-ppedrot-static-hint-poly.sh deleted file mode 100644 index 7bed43afe1..0000000000 --- a/dev/ci/user-overlays/12977-ppedrot-static-hint-poly.sh +++ /dev/null @@ -1,9 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "12977" ] || [ "$CI_BRANCH" = "static-hint-poly" ]; then - - equations_CI_REF=static-hint-poly - equations_CI_GITURL=https://github.com/ppedrot/Coq-Equations - - fiat_parsers_CI_REF=static-hint-poly - fiat_parsers_CI_GITURL=https://github.com/ppedrot/fiat - -fi diff --git a/dev/ci/user-overlays/13028-herbelin-master+fix-quotations-printing.sh b/dev/ci/user-overlays/13028-herbelin-master+fix-quotations-printing.sh deleted file mode 100644 index 3407c2db39..0000000000 --- a/dev/ci/user-overlays/13028-herbelin-master+fix-quotations-printing.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "13028" ] || [ "$CI_BRANCH" = "master+fix-quotations-printing" ]; then - - equations_CI_REF=master+adapt-coq-pr13028-quotation-qualifier-printing - equations_CI_GITURL=https://github.com/herbelin/Coq-Equations - -fi diff --git a/dev/ci/user-overlays/13128-SkySkimmer-noinstance.sh b/dev/ci/user-overlays/13128-SkySkimmer-noinstance.sh new file mode 100644 index 0000000000..f16cf1497e --- /dev/null +++ b/dev/ci/user-overlays/13128-SkySkimmer-noinstance.sh @@ -0,0 +1,5 @@ +if [ "$CI_PULL_REQUEST" = "13128" ] || [ "$CI_BRANCH" = "noinstance" ]; then + + overlay elpi https://github.com/SkySkimmer/coq-elpi noinstance + +fi diff --git a/dev/ci/user-overlays/13166-herbelin-master+fixes13165-missing-impargs-defined-fields.sh b/dev/ci/user-overlays/13166-herbelin-master+fixes13165-missing-impargs-defined-fields.sh new file mode 100644 index 0000000000..7d55cf6883 --- /dev/null +++ b/dev/ci/user-overlays/13166-herbelin-master+fixes13165-missing-impargs-defined-fields.sh @@ -0,0 +1,6 @@ +if [ "$CI_PULL_REQUEST" = "13166" ] || [ "$CI_BRANCH" = "master+fixes13165-missing-impargs-defined-fields" ]; then + + elpi_CI_REF=coq-master+adapt-coq-pr13166-impargs-record-fields + elpi_CI_GITURL=https://github.com/herbelin/coq-elpi + +fi diff --git a/dev/ci/user-overlays/8808-herbelin-master+support-binder+term-in-abbrev.sh b/dev/ci/user-overlays/8808-herbelin-master+support-binder+term-in-abbrev.sh deleted file mode 100644 index 50eaf0b109..0000000000 --- a/dev/ci/user-overlays/8808-herbelin-master+support-binder+term-in-abbrev.sh +++ /dev/null @@ -1,6 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "8808" ] || [ "$CI_BRANCH" = "master+support-binder+term-in-abbrev" ]; then - - elpi_CI_REF=master+adapt-coq8808-syndef-same-expressiveness-notation - elpi_CI_GITURL=https://github.com/herbelin/coq-elpi - -fi diff --git a/dev/ci/user-overlays/8855-herbelin-master+more-search-options.sh b/dev/ci/user-overlays/8855-herbelin-master+more-search-options.sh deleted file mode 100644 index 3b3b20baf1..0000000000 --- a/dev/ci/user-overlays/8855-herbelin-master+more-search-options.sh +++ /dev/null @@ -1,9 +0,0 @@ -if [ "$CI_PULL_REQUEST" = "8855" ] || [ "$CI_BRANCH" = "master+more-search-options" ]; then - - coqhammer_CI_REF=master+adapt-pr8855-search-api - coqhammer_CI_GITURL=https://github.com/herbelin/coqhammer - - coq_dpdgraph_CI_REF=coq-master+adapt-pr8855-search-api - coq_dpdgraph_CI_GITURL=https://github.com/herbelin/coq-dpdgraph - -fi diff --git a/dev/ci/user-overlays/README.md b/dev/ci/user-overlays/README.md index 4c2f264a74..3f9ad5e878 100644 --- a/dev/ci/user-overlays/README.md +++ b/dev/ci/user-overlays/README.md @@ -4,15 +4,12 @@ When your pull request breaks an external project we test in our CI and you have prepared a branch with the fix, you can add an "overlay" to your pull 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 / 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. +An overlay is a file which defines where to look for the patched +version so that testing is possible. This is done by calling the +`overlay` command for each project with the project name (as used in +the variables in [`ci-basic-overlay.sh`](../ci-basic-overlay.sh)), the +location of your fork and the branch containing the patch on your +fork. Moreover, the file contains very simple logic to test the pull request number or branch name and apply it only in this case. @@ -21,13 +18,12 @@ The name of your overlay file should start with a five-digit pull request number, followed by a dash, anything (for instance your GitHub nickname and the branch name), then a `.sh` extension (`[0-9]{5}-[a-zA-Z0-9-_]+.sh`). -Example: `10185-SkySkimmer-instance-no-bang.sh` containing +Example: `13128-SkySkimmer-noinstance.sh` containing ``` -if [ "$CI_PULL_REQUEST" = "10185" ] || [ "$CI_BRANCH" = "instance-no-bang" ]; then +if [ "$CI_PULL_REQUEST" = "13128" ] || [ "$CI_BRANCH" = "noinstance" ]; then - quickchick_CI_REF=instance-no-bang - quickchick_CI_GITURL=https://github.com/SkySkimmer/QuickChick + overlay elpi https://github.com/SkySkimmer/coq-elpi noinstance fi ``` diff --git a/dev/doc/changes.md b/dev/doc/changes.md index 59c1623a2d..6a6318f97a 100644 --- a/dev/doc/changes.md +++ b/dev/doc/changes.md @@ -1,15 +1,35 @@ ## Changes between Coq 8.12 and Coq 8.13 -- Tactic language: TacGeneric now takes an argument to tell if it - comes from a notation. Use `None` if not and `Some foo` to tell to - print such TacGeneric surrounded with `foo:( )`. - ### Code formatting - The automatic code formatting tool `ocamlformat` has been disabled and its git hook removed. If desired, automatic formatting can be achieved by calling the `fmt` target of the dune build system. +### ML API + +Abstract syntax of tactic: + +- TacGeneric now takes an argument to tell if it comes from a + notation. Use `None` if not and `Some foo` to tell to print such + TacGeneric surrounded with `foo:( )`. + +Printing functions: + +- `Pp.h` does not take a `int` argument anymore (the argument was + not used). In general, where `h n` for `n` non zero was used, `hv n` + was instead intended. If cancelling the breaking role of cuts in the + box was intended, turn `h n c` into `h c`. + +Grammar entries: + +- `Prim.pattern_identref` is deprecated, use `Prim.pattern_ident` + which now returns a located identifier. + +Generic arguments: + +- Generic arguments: `wit_var` is deprecated, use `wit_hyp`. + ## Changes between Coq 8.11 and Coq 8.12 ### Code formatting diff --git a/dev/tools/create_overlays.sh b/dev/tools/create_overlays.sh index ad60b1115f..78ed27ba03 100755 --- a/dev/tools/create_overlays.sh +++ b/dev/tools/create_overlays.sh @@ -66,8 +66,7 @@ do make ci-$_CONTRIB_NAME || true setup_contrib_git $_CONTRIB_DIR $_CONTRIB_GITPUSHURL - echo " ${_CONTRIB_NAME}_CI_REF=$OVERLAY_BRANCH" >> $OVERLAY_FILE - echo " ${_CONTRIB_NAME}_CI_GITURL=$_CONTRIB_GITURL" >> $OVERLAY_FILE + echo " overlay ${_CONTRIB_NAME} $_CONTRIB_GITURL $OVERLAY_BRANCH" >> $OVERLAY_FILE echo "" >> $OVERLAY_FILE shift done diff --git a/doc/changelog/02-specification-language/10331-minim-prop-toset.rst b/doc/changelog/02-specification-language/10331-minim-prop-toset.rst new file mode 100644 index 0000000000..6c442ca1aa --- /dev/null +++ b/doc/changelog/02-specification-language/10331-minim-prop-toset.rst @@ -0,0 +1,5 @@ +- **Changed:** Heuristics for universe minimization to :g:`Set`: also + use constraints ``Prop <= i`` (`#10331 + <https://github.com/coq/coq/pull/10331>`_, by Gaëtan Gilbert with + help from Maxime Dénès and Matthieu Sozeau, fixes `#12414 + <https://github.com/coq/coq/issues/12414>`_). diff --git a/doc/changelog/02-specification-language/13106-doc-and-changelog-for-13106.rst b/doc/changelog/02-specification-language/13106-doc-and-changelog-for-13106.rst new file mode 100644 index 0000000000..7fe69c39c1 --- /dev/null +++ b/doc/changelog/02-specification-language/13106-doc-and-changelog-for-13106.rst @@ -0,0 +1,5 @@ +- **Removed:** + Undocumented and experimental forward class hint feature ``:>>``. + Use ``:>`` (see :n:`@of_type`) instead + (`#13106 <https://github.com/coq/coq/pull/13106>`_, + by Pierre-Marie Pédrot). diff --git a/doc/changelog/02-specification-language/13166-master+fixes13165-missing-impargs-defined-fields.rst b/doc/changelog/02-specification-language/13166-master+fixes13165-missing-impargs-defined-fields.rst new file mode 100644 index 0000000000..006989e6b3 --- /dev/null +++ b/doc/changelog/02-specification-language/13166-master+fixes13165-missing-impargs-defined-fields.rst @@ -0,0 +1,5 @@ +- **Fixed:** + Implicit arguments taken into account in defined fields of a record type declaration + (`#13166 <https://github.com/coq/coq/pull/13166>`_, + fixes `#13165 <https://github.com/coq/coq/issues/13165>`_, + by Hugo Herbelin). diff --git a/doc/changelog/03-notations/12950-master+reorganization-notations-only-parsing-only-printing.rst b/doc/changelog/03-notations/12950-master+reorganization-notations-only-parsing-only-printing.rst new file mode 100644 index 0000000000..16fc91f911 --- /dev/null +++ b/doc/changelog/03-notations/12950-master+reorganization-notations-only-parsing-only-printing.rst @@ -0,0 +1,10 @@ +- **Changed:** + New model for ``only parsing`` and ``only printing`` notations with + support for at most one parsing-and-printing or only-parsing + notation per notation and scope, but an arbitrary number of + only-printing notations + (`#12950 <https://github.com/coq/coq/pull/12950>`_, + fixes `#4738 <https://github.com/coq/coq/issues/4738>`_ + and `#9682 <https://github.com/coq/coq/issues/9682>`_ + and part 2 of `#12908 <https://github.com/coq/coq/issues/12908>`_, + by Hugo Herbelin). diff --git a/doc/changelog/04-tactics/12648-zify-int63.rst b/doc/changelog/04-tactics/12648-zify-int63.rst new file mode 100644 index 0000000000..ec7a1273e4 --- /dev/null +++ b/doc/changelog/04-tactics/12648-zify-int63.rst @@ -0,0 +1,3 @@ +- **Added:** + The :tacn:`zify` tactic provides support for primitive integers (module :g:`ZifyInt63`). + (`#12648 <https://github.com/coq/coq/pull/12648>`_, by Frédéric Besson). diff --git a/doc/changelog/09-coqide/00000-title.rst b/doc/changelog/09-coqide/00000-title.rst index 0fc27cf380..c95e2133d6 100644 --- a/doc/changelog/09-coqide/00000-title.rst +++ b/doc/changelog/09-coqide/00000-title.rst @@ -1,3 +1,3 @@ -**CoqIDE** +**|CoqIDE|** diff --git a/doc/changelog/09-coqide/12874-show_proof_diffs.rst b/doc/changelog/09-coqide/12874-show_proof_diffs.rst new file mode 100644 index 0000000000..51bebad9be --- /dev/null +++ b/doc/changelog/09-coqide/12874-show_proof_diffs.rst @@ -0,0 +1,5 @@ +- **Added:** + Support showing diffs for :cmd:`Show Proof` in CoqIDE from the :n:`View` menu. + See :ref:`showing_proof_diffs`. + (`#12874 <https://github.com/coq/coq/pull/12874>`_, + by Jim Fehrle and Enrico Tassi) diff --git a/doc/sphinx/_static/coqdoc.css b/doc/sphinx/_static/coqdoc.css index 32cb0a7a15..c0b4ee4a9f 100644 --- a/doc/sphinx/_static/coqdoc.css +++ b/doc/sphinx/_static/coqdoc.css @@ -66,3 +66,7 @@ .coqdoc-tactic { font-weight: bold; } + +.smallcaps { + font-variant: small-caps; +} diff --git a/doc/sphinx/_static/diffs-show-proof.png b/doc/sphinx/_static/diffs-show-proof.png Binary files differnew file mode 100644 index 0000000000..62bd9cccd0 --- /dev/null +++ b/doc/sphinx/_static/diffs-show-proof.png diff --git a/doc/sphinx/addendum/extraction.rst b/doc/sphinx/addendum/extraction.rst index c2249b8e57..96e115fc3d 100644 --- a/doc/sphinx/addendum/extraction.rst +++ b/doc/sphinx/addendum/extraction.rst @@ -16,7 +16,7 @@ Before using any of the commands or options described in this chapter, the extraction framework should first be loaded explicitly via ``Require Extraction``, or via the more robust ``From Coq Require Extraction``. -Note that in earlier versions of Coq, these commands and options were +Note that in earlier versions of |Coq|, these commands and options were directly available without any preliminary ``Require``. .. coqtop:: in @@ -72,10 +72,10 @@ produce one monolithic file or one file per |Coq| library. Recursive extraction of all the mentioned objects and all their dependencies, just as :n:`Extraction @string {+ @qualid }`, but instead of producing one monolithic file, this command splits - the produced code in separate ML files, one per corresponding Coq + the produced code in separate ML files, one per corresponding |Coq| ``.v`` file. This command is hence quite similar to :cmd:`Recursive Extraction Library`, except that only the needed - parts of Coq libraries are extracted instead of the whole. + parts of |Coq| libraries are extracted instead of the whole. The naming convention in case of name clash is the same one as :cmd:`Extraction Library`: identifiers are here renamed using prefixes ``coq_`` or ``Coq_``. @@ -99,10 +99,18 @@ Extraction Options Setting the target language ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.. cmd:: Extraction Language {| OCaml | Haskell | Scheme | JSON } +.. cmd:: Extraction Language @language :name: Extraction Language - The ability to fix target language is the first and more important + .. insertprodn language language + + .. prodn:: + language ::= OCaml + | Haskell + | Scheme + | JSON + + The ability to fix target language is the first and most important of the extraction options. Default is ``OCaml``. The JSON output is mostly for development or debugging: @@ -138,7 +146,7 @@ and commands: Default is on. This controls all type-preserving optimizations made on the ML terms (mostly reduction of dummy beta/iota redexes, but also simplifications on Cases, etc). Turn this flag off if you want a - ML term as close as possible to the Coq term. + ML term as close as possible to the |Coq| term. .. flag:: Extraction Conservative Types @@ -215,14 +223,15 @@ code elimination performed during extraction, in a way which is independent but complementary to the main elimination principles of extraction (logical parts and types). -.. cmd:: Extraction Implicit @qualid [ {+ @ident } ] +.. cmd:: Extraction Implicit @qualid [ {* {| @ident | @integer } } ] - This experimental command allows declaring some arguments of - :token:`qualid` as implicit, i.e. useless in extracted code and hence to - be removed by extraction. Here :token:`qualid` can be any function or - inductive constructor, and the given :token:`ident` are the names of - the concerned arguments. In fact, an argument can also be referred - by a number indicating its position, starting from 1. + Declares some arguments of + :token:`qualid` as implicit, meaning that they are useless in extracted code. + The extracted code will omit these arguments. + Here :token:`qualid` can be + any function or inductive constructor, and the :token:`ident`\s are + the names of the useless arguments. Arguments can can also be + identified positionally by :token:`integer`\s starting from 1. When an actual extraction takes place, an error is normally raised if the :cmd:`Extraction Implicit` declarations cannot be honored, that is @@ -254,12 +263,24 @@ a closed term, and of course the system cannot guess the program which realizes an axiom. Therefore, it is possible to tell the system what ML term corresponds to a given axiom. -.. cmd:: Extract Constant @qualid => @string +.. cmd:: Extract Constant @qualid {* @string__tv } => {| @ident | @string } Give an ML extraction for the given constant. - The :token:`string` may be an identifier or a quoted string. -.. cmd:: Extract Inlined Constant @qualid => @string + :n:`@string__tv` + If the type scheme axiom is an arity (a sequence of products followed + by a sort), then some type + variables have to be given (as quoted strings). + + The number of type variables is checked by the system. For example: + + .. coqtop:: in + + Axiom Y : Set -> Set -> Set. + Extract Constant Y "'a" "'b" => " 'a * 'b ". + + +.. cmd:: Extract Inlined Constant @qualid => {| @ident | @string } Same as the previous one, except that the given ML terms will be inlined everywhere instead of being declared via a ``let``. @@ -282,20 +303,6 @@ what ML term corresponds to a given axiom. Extract Constant X => "int". Extract Constant x => "0". -Notice that in the case of type scheme axiom (i.e. whose type is an -arity, that is a sequence of product finished by a sort), then some type -variables have to be given (as quoted strings). The syntax is then: - -.. cmdv:: Extract Constant @qualid {+ @string } => @string - :undocumented: - -The number of type variables is checked by the system. For example: - -.. coqtop:: in - - Axiom Y : Set -> Set -> Set. - Extract Constant Y "'a" "'b" => " 'a * 'b ". - Realizing an axiom via :cmd:`Extract Constant` is only useful in the case of an informative axiom (of sort ``Type`` or ``Set``). A logical axiom has no computational content and hence will not appear in extracted @@ -316,36 +323,35 @@ The system also provides a mechanism to specify ML terms for inductive types and constructors. For instance, the user may want to use the ML native boolean type instead of the |Coq| one. The syntax is the following: -.. cmd:: Extract Inductive @qualid => @string__1 [ {+ @string } ] +.. cmd:: Extract Inductive @qualid => {| @ident | @string } [ {* {| @ident | @string } } ] {? @string__match } Give an ML extraction for the given inductive type. You must specify - extractions for the type itself (:n:`@string__1`) and all its - constructors (all the :n:`@string` between square brackets). In this form, + extractions for the type itself (the initial :n:`{| @ident | @string }`) and all its + constructors (the :n:`[ {* {| @ident | @string } } ]`). In this form, the ML extraction must be an ML inductive datatype, and the native pattern matching of the language will be used. - When :n:`@string__1` matches the name of the type of characters or strings + When the initial :n:`{| @ident | @string }` matches the name of the type of characters or strings (``char`` and ``string`` for OCaml, ``Prelude.Char`` and ``Prelude.String`` for Haskell), extraction of literals is handled in a specialized way, so as to generate literals in the target language. This feature requires the type designated by :n:`@qualid` to be registered as the standard char or string type, using the :cmd:`Register` command. -.. cmdv:: Extract Inductive @qualid => @string [ {+ @string } ] @string - - Same as before, with a final extra :token:`string` that indicates how to - perform pattern matching over this inductive type. In this form, - the ML extraction could be an arbitrary type. - For an inductive type with :math:`k` constructors, the function used to - emulate the pattern matching should expect :math:`k+1` arguments, first the :math:`k` - branches in functional form, and then the inductive element to - destruct. For instance, the match branch ``| S n => foo`` gives the - functional form ``(fun n -> foo)``. Note that a constructor with no - arguments is considered to have one unit argument, in order to block - early evaluation of the branch: ``| O => bar`` leads to the functional - form ``(fun () -> bar)``. For instance, when extracting :g:`nat` - into |OCaml| ``int``, the code to be provided has type: - ``(unit->'a)->(int->'a)->int->'a``. + :n:`@string__match` + Indicates how to + perform pattern matching over this inductive type. In this form, + the ML extraction could be an arbitrary type. + For an inductive type with :math:`k` constructors, the function used to + emulate the pattern matching should expect :math:`k+1` arguments, first the :math:`k` + branches in functional form, and then the inductive element to + destruct. For instance, the match branch ``| S n => foo`` gives the + functional form ``(fun n -> foo)``. Note that a constructor with no + arguments is considered to have one unit argument, in order to block + early evaluation of the branch: ``| O => bar`` leads to the functional + form ``(fun () -> bar)``. For instance, when extracting :g:`nat` + into |OCaml| ``int``, the code to be provided has type: + ``(unit->'a)->(int->'a)->int->'a``. .. caution:: As for :cmd:`Extract Constant`, this command should be used with care: @@ -434,7 +440,7 @@ Additional settings Controls which optimizations are used during extraction, providing a finer-grained control than :flag:`Extraction Optimize`. The bits of :token:`natural` are used as a bit mask. - Keeping an option off keeps the extracted ML more similar to the Coq term. + Keeping an option off keeps the extracted ML more similar to the |Coq| term. Values are: +-----+-------+----------------------------------------------------------------+ @@ -465,7 +471,7 @@ Additional settings .. flag:: Extraction TypeExpand - If set, fully expand Coq types in ML. See the Coq source code to learn more. + If set, fully expand |Coq| types in ML. See the |Coq| source code to learn more. Differences between |Coq| and ML type systems ---------------------------------------------- @@ -515,7 +521,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 -from a Coq well-typed terms, so for example inductive types will always +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 of the right shape (from the |Coq| point-of-view). @@ -524,7 +530,7 @@ More details about the correctness of the extracted programs can be 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| +occur. For example all the programs of |Coq| library are accepted by the |OCaml| 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 759f630b85..407a38378f 100644 --- a/doc/sphinx/addendum/generalized-rewriting.rst +++ b/doc/sphinx/addendum/generalized-rewriting.rst @@ -35,7 +35,7 @@ the previous implementation in several ways: the new implementation, if one provides the proper morphisms. Again, most of the work is handled in the tactics. + First-class morphisms and signatures. Signatures and morphisms are - ordinary Coq terms, hence they can be manipulated inside Coq, put + ordinary |Coq| terms, hence they can be manipulated inside |Coq|, put inside structures and lemmas about them can be proved inside the system. Higher-order morphisms are also allowed. + Performance. The implementation is based on a depth-first search for @@ -103,7 +103,7 @@ argument. Morphisms can also be contravariant in one or more of their arguments. A morphism is contravariant on an argument associated to the relation instance :math:`R` if it is covariant on the same argument when the inverse -relation :math:`R^{−1}` (``inverse R`` in Coq) is considered. The special arrow ``-->`` +relation :math:`R^{−1}` (``inverse R`` in |Coq|) is considered. The special arrow ``-->`` is used in signatures for contravariant morphisms. Functions having arguments related by symmetric relations instances @@ -144,7 +144,7 @@ always the intended equality for a given structure. In the next section we will describe the commands to register terms as parametric relations and morphisms. Several tactics that deal with -equality in Coq can also work with the registered relations. The exact +equality in |Coq| can also work with the registered relations. The exact list of tactics will be given :ref:`in this section <tactics-enabled-on-user-provided-relations>`. For instance, the tactic reflexivity can be used to solve a goal ``R n n`` whenever ``R`` is an instance of a registered reflexive relation. However, the @@ -170,10 +170,17 @@ compatibility constraints. Adding new relations and morphisms ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.. cmd:: Add Parametric Relation {* @binder } : (A t1 ... tn) (Aeq t′1 ... t′m) {? reflexivity proved by @term} {? symmetry proved by @term} {? transitivity proved by @term} as @ident +.. cmd:: Add Parametric Relation {* @binder } : @one_term__A @one_term__Aeq {? reflexivity proved by @one_term } {? symmetry proved by @one_term } {? transitivity proved by @one_term } as @ident - This command declares a parametric relation :g:`Aeq: forall (y1 : β1 ... ym : βm)`, - :g:`relation (A t1 ... tn)` over :g:`(A : αi -> ... αn -> Type)`. + Declares a parametric relation of :n:`@one_term__A`, which is a `Type`, say `T`, with + :n:`@one_term__Aeq`, which is a relation on `T`, i.e. of type `(T -> T -> Prop)`. + Thus, if :n:`@one_term__A` is + :n:`A: forall α__1 … α__n, Type` then :n:`@one_term__Aeq` is + :n:`Aeq: forall α__1 … α__n, (A α__1 … α__n) -> (A α__1 … α__n) -> Prop`, + or equivalently, :n:`Aeq: forall α__1 … α__n, relation (A α__1 … α__n)`. + + :n:`@one_term__A` and :n:`@one_term__Aeq` must be typeable under the context + :token:`binder`\s. In practice, the :token:`binder`\s usually correspond to the :n:`α`\s The final :token:`ident` gives a unique name to the morphism and it is used by the command to generate fresh names for automatically provided @@ -189,16 +196,16 @@ Adding new relations and morphisms To use this command, you need to first import the module ``Setoid`` using the command ``Require Import Setoid``. -.. cmd:: Add Relation +.. cmd:: Add Relation @one_term @one_term {? reflexivity proved by @one_term } {? symmetry proved by @one_term } {? transitivity proved by @one_term } as @ident - In case the carrier and relations are not parametric, one can use this command + If the carrier and relations are not parametric, use this command instead, whose syntax is the same except there is no local context. The proofs of reflexivity, symmetry and transitivity can be omitted if the relation is not an equivalence relation. The proofs must be instances of the corresponding relation definitions: e.g. the proof of reflexivity must have a type convertible to - :g:`reflexive (A t1 ... tn) (Aeq t′ 1 …t′ n)`. + :g:`reflexive (A t1 … tn) (Aeq t′ 1 … t′ n)`. Each proof may refer to the introduced variables as well. .. example:: Parametric relation @@ -219,10 +226,10 @@ replace terms with related ones only in contexts that are syntactic compositions of parametric morphism instances declared with the following command. -.. cmd:: Add Parametric Morphism {* @binder } : (@ident {+ @term__1}) with signature @term__2 as @ident +.. cmd:: Add Parametric Morphism {* @binder } : @one_term with signature @term as @ident - This command declares a parametric morphism :n:`@ident {+ @term__1}` of - signature :n:`@term__2`. The final identifier :token:`ident` gives a unique + Declares a parametric morphism :n:`@one_term` of + signature :n:`@term`. The final identifier :token:`ident` gives a unique name to the morphism and it is used as the base name of the typeclass instance definition and as the name of the lemma that proves the well-definedness of the morphism. The parameters of the morphism as well as @@ -525,12 +532,13 @@ counterparts when the relation involved is not Leibniz equality. Notice, however, that using the prefixed tactics it is possible to pass additional arguments such as ``using relation``. -.. tacv:: setoid_reflexivity - setoid_symmetry {? in @ident} - setoid_transitivity - setoid_rewrite {? @orientation} @term {? at @occurrences} {? in @ident} - setoid_replace @term with @term {? using relation @term} {? in @ident} {? by @ltac_expr3} - :name: setoid_reflexivity; setoid_symmetry; setoid_transitivity; setoid_rewrite; setoid_replace +.. tacn:: setoid_reflexivity + setoid_symmetry {? in @ident } + setoid_transitivity @one_term + setoid_rewrite {? {| -> | <- } } @one_term {? with @bindings } {? at @occurrences } {? in @ident } + setoid_rewrite {? {| -> | <- } } @one_term {? with @bindings } in @ident at @occurrences + setoid_replace @one_term with @one_term {? using relation @one_term } {? in @ident } {? at {+ @int_or_var } } {? by @ltac_expr3 } + :name: setoid_reflexivity; setoid_symmetry; setoid_transitivity; setoid_rewrite; _; setoid_replace The ``using relation`` arguments cannot be passed to the unprefixed form. The latter argument tells the tactic what parametric relation should @@ -553,34 +561,35 @@ system up to user defined equalities. Printing relations and morphisms ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.. cmd:: Print Instances +Use the :cmd:`Print Instances` command with the class names ``Reflexive``, ``Symmetric`` +or ``Transitive`` to print registered reflexive, symmetric or transitive relations and +with the class name ``Proper`` to print morphisms. - This command can be used to show the list of currently - registered ``Reflexive`` (using ``Print Instances Reflexive``), ``Symmetric`` - or ``Transitive`` relations, Equivalences, PreOrders, PERs, and Morphisms - (implemented as ``Proper`` instances). When the rewriting tactics refuse - to replace a term in a context because the latter is not a composition - of morphisms, the :cmd:`Print Instances` command can be useful to understand - what additional morphisms should be registered. +When rewriting tactics refuse +to replace a term in a context because the latter is not a composition +of morphisms, this command can be useful to understand +what additional morphisms should be registered. .. _deprecated_syntax_for_generalized_rewriting: Deprecated syntax and backward incompatibilities ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.. cmd:: Add Setoid @qualid__1 @qualid__2 @qualid__3 as @ident +.. cmd:: Add Setoid @one_term__carrier @one_term__congruence @one_term__proofs as @ident This command for declaring setoids and morphisms is also accepted due to backward compatibility reasons. - Here :n:`@qualid__2` is a congruence relation without parameters, :n:`@qualid__1` is its carrier - and :n:`@qualid__3` is an object of type (:n:`Setoid_Theory @qualid__1 @qualid__2`) (i.e. a record + Here :n:`@one_term__congruence` is a congruence relation without parameters, + :n:`@one_term__carrier` is its carrier and :n:`@one_term__proofs` is an object + of type (:n:`Setoid_Theory @one_term__carrier @one_term__congruence`) (i.e. a record packing together the reflexivity, symmetry and transitivity lemmas). Notice that the syntax is not completely backward compatible since the identifier was not required. -.. cmd:: Add Morphism @ident : @ident - :name: Add Morphism +.. cmd:: Add Morphism @one_term : @ident + Add Morphism @one_term with signature @term as @ident + :name: Add Morphism; _ This command is restricted to the declaration of morphisms without parameters. It is not fully backward compatible since the @@ -590,11 +599,10 @@ Deprecated syntax and backward incompatibilities bi-implication in place of a simple implication. In practice, porting an old development to the new semantics is usually quite simple. -.. cmd:: Declare Morphism @ident : @ident +.. cmd:: Declare Morphism @one_term : @ident :name: Declare Morphism - This commands is to be used in a module type to declare a parameter that - is a morphism. + Declares a parameter in a module type that is a morphism. Notice that several limitations of the old implementation have been lifted. In particular, it is now possible to declare several relations diff --git a/doc/sphinx/addendum/implicit-coercions.rst b/doc/sphinx/addendum/implicit-coercions.rst index dafa510ade..b81212ad0d 100644 --- a/doc/sphinx/addendum/implicit-coercions.rst +++ b/doc/sphinx/addendum/implicit-coercions.rst @@ -125,10 +125,16 @@ term consists of the successive application of its coercions. Declaring Coercions ------------------------- -.. cmd:: Coercion @qualid : @class >-> @class +.. cmd:: Coercion @reference : @class >-> @class + Coercion @ident {? @univ_decl } @def_body - Declares the construction denoted by :token:`qualid` as a coercion between - the two given classes. + :name: Coercion; _ + + The first form declares the construction denoted by :token:`reference` as a coercion between + the two given classes. The second form defines :token:`ident` + just like :cmd:`Definition` :n:`@ident {? @univ_decl } @def_body` + and then declares :token:`ident` as a coercion between it source and its target. + Both forms support the :attr:`local` attribute, which makes the coercion local to the current section. .. exn:: @qualid not declared. :undocumented: @@ -174,21 +180,6 @@ Declaring Coercions circular. When a new circular coercion path is not convertible with the identity function, it will be reported as ambiguous. - .. cmdv:: Local Coercion @qualid : @class >-> @class - - Declares the construction denoted by :token:`qualid` as a coercion local to - the current section. - - .. cmdv:: Coercion @ident := @term {? @type } - - This defines :token:`ident` just like :n:`Definition @ident := term {? @type }`, - and then declares :token:`ident` as a coercion between it source and its target. - - .. cmdv:: Local Coercion @ident := @term {? @type } - - This defines :token:`ident` just like :n:`Let @ident := @term {? @type }`, - and then declares :token:`ident` as a coercion between it source and its target. - Some objects can be declared as coercions when they are defined. This applies to :ref:`assumptions<gallina-assumptions>` and constructors of :ref:`inductive types and record fields<gallina-inductive-definitions>`. @@ -205,13 +196,11 @@ Use :n:`:>` instead of :n:`:` before the function with type :g:`forall (x₁:T₁)..(xₙ:Tₙ)(y:C x₁..xₙ),D t₁..tₘ`, and we declare it as an identity coercion between ``C`` and ``D``. + This command supports the :attr:`local` attribute, which makes the coercion local to the current section. + .. exn:: @class must be a transparent constant. :undocumented: - .. cmdv:: Local Identity Coercion @ident : @ident >-> @ident - - Same as :cmd:`Identity Coercion` but locally to the current section. - .. cmd:: SubClass @ident_decl @def_body :name: SubClass @@ -223,9 +212,7 @@ Use :n:`:>` instead of :n:`:` before the :n:`Definition @ident := @type.` :n:`Identity Coercion Id_@ident_@ident' : @ident >-> @ident'`. - .. cmdv:: Local SubClass @ident_decl @def_body - - Same as before but locally to the current section. + This command supports the :attr:`local` attribute, which makes the coercion local to the current section. Displaying Available Coercions @@ -268,24 +255,15 @@ Classes as Records .. index:: :> (coercion) -We allow the definition of *Structures with Inheritance* (or classes as records) -by extending the existing :cmd:`Record` macro. Its new syntax is: - -.. cmdv:: {| Record | Structure } {? >} @ident {* @binder } : @sort := {? @ident} { {+; @ident :{? >} @term } } - - The first identifier :token:`ident` is the name of the defined record and - :token:`sort` is its type. The optional identifier after ``:=`` is the name - of the constructor (it will be :n:`Build_@ident` if not given). - The other identifiers are the names of the fields, and :token:`term` - are their respective types. If ``:>`` is used instead of ``:`` in - the declaration of a field, then the name of this field is automatically - declared as a coercion from the record name to the class of this - field type. Note that the fields always verify the uniform - inheritance condition. If the optional ``>`` is given before the - record name, then the constructor name is automatically declared as - a coercion from the class of the last field type to the record name - (this may fail if the uniform inheritance condition is not - satisfied). +*Structures with Inheritance* may be defined using the :cmd:`Record` command. + +Use `>` before the record name to declare the constructor name as +a coercion from the class of the last field type to the record name +(this may fail if the uniform inheritance condition is not +satisfied). See :token:`record_definition`. + +Use `:>` in the field type to declare the field as a coercion from the record name +to the class of the field type. See :token:`of_type`. Coercions and Sections ---------------------- diff --git a/doc/sphinx/addendum/micromega.rst b/doc/sphinx/addendum/micromega.rst index ba5bac6489..0942a82d6f 100644 --- a/doc/sphinx/addendum/micromega.rst +++ b/doc/sphinx/addendum/micromega.rst @@ -25,8 +25,8 @@ tactics for solving arithmetic goals over :math:`\mathbb{Q}`, ``n`` is an optional integer limiting the proof search depth, is an incomplete proof procedure for non-linear arithmetic. It is based on John Harrison’s HOL Light - driver to the external prover `csdp` [#csdp]_. Note that the `csdp` driver is - generating a *proof cache* which makes it possible to rerun scripts + driver to the external prover `csdp` [#csdp]_. Note that the `csdp` driver + generates a *proof cache* which makes it possible to rerun scripts even without `csdp`. .. flag:: Simplex @@ -250,7 +250,7 @@ proof by abstracting monomials by variables. `psatz`: a proof procedure for non-linear arithmetic ---------------------------------------------------- -.. tacn:: psatz +.. tacn:: psatz @one_term {? @int_or_var } :name: psatz This tactic explores the *Cone* by increasing degrees – hence the @@ -260,7 +260,7 @@ proof by abstracting monomials by variables. that might miss a refutation. To illustrate the working of the tactic, consider we wish to prove the - following Coq goal: + following |Coq| goal: .. needs csdp .. coqdoc:: @@ -283,60 +283,103 @@ obtain :math:`-1`. By Theorem :ref:`Psatz <psatz_thm>`, the goal is valid. .. tacn:: zify :name: zify - This tactic is internally called by :tacn:`lia` to support additional types e.g., :g:`nat`, :g:`positive` and :g:`N`. - By requiring the module ``ZifyBool``, the boolean type :g:`bool` and some comparison operators are also supported. + This tactic is internally called by :tacn:`lia` to support additional types, e.g., :g:`nat`, :g:`positive` and :g:`N`. + Additional support is provided by the following modules: + + + For boolean operators (e.g., :g:`Nat.leb`), require the module :g:`ZifyBool`. + + For comparison operators (e.g., :g:`Z.compare`), require the module :g:`ZifyComparison`. + + For native 63 bit integers, require the module :g:`ZifyInt63`. + :tacn:`zify` can also be extended by rebinding the tactics `Zify.zify_pre_hook` and `Zify.zify_post_hook` that are respectively run in the first and the last steps of :tacn:`zify`. + To support :g:`Z.div` and :g:`Z.modulo`: ``Ltac Zify.zify_post_hook ::= Z.div_mod_to_equations``. + To support :g:`Z.quot` and :g:`Z.rem`: ``Ltac Zify.zify_post_hook ::= Z.quot_rem_to_equations``. - + To support :g:`Z.div`, :g:`Z.modulo`, :g:`Z.quot`, and :g:`Z.rem`: ``Ltac Zify.zify_post_hook ::= Z.to_euclidean_division_equations``. + + To support :g:`Z.div`, :g:`Z.modulo`, :g:`Z.quot` and :g:`Z.rem`: either ``Ltac Zify.zify_post_hook ::= Z.to_euclidean_division_equations`` or ``Ltac Zify.zify_convert_to_euclidean_division_equations_flag ::= constr:(true)``. The :tacn:`zify` tactic can be extended with new types and operators by declaring and registering new typeclass instances using the following commands. The typeclass declarations can be found in the module ``ZifyClasses`` and the default instances can be found in the module ``ZifyInst``. -.. cmd:: Add Zify {| InjTyp | BinOp | UnOp |CstOp | BinRel | UnOpSpec | BinOpSpec } @qualid +.. cmd:: Add Zify @add_zify @one_term - This command registers an instance of one of the typeclasses among ``InjTyp``, ``BinOp``, ``UnOp``, ``CstOp``, ``BinRel``, - ``UnOpSpec``, ``BinOpSpec``. + .. insertprodn add_zify add_zify + + .. prodn:: + add_zify ::= {| InjTyp | BinOp | UnOp | CstOp | BinRel | UnOpSpec | BinOpSpec } + | {| PropOp | PropBinOp | PropUOp | Saturate } -.. cmd:: Show Zify {| InjTyp | BinOp | UnOp |CstOp | BinRel | UnOpSpec | BinOpSpec } + Registers an instance of the specified typeclass. - The command prints the typeclass instances of one the typeclasses - among ``InjTyp``, ``BinOp``, ``UnOp``, ``CstOp``, ``BinRel``, - ``UnOpSpec``, ``BinOpSpec``. For instance, :cmd:`Show Zify` ``InjTyp`` +.. cmd:: Show Zify @show_zify + + .. insertprodn show_zify show_zify + + .. prodn:: + show_zify ::= {| InjTyp | BinOp | UnOp | CstOp | BinRel | UnOpSpec | BinOpSpec | Spec } + + Prints instances for the specified typeclass. For instance, :cmd:`Show Zify` ``InjTyp`` prints the list of types that supported by :tacn:`zify` i.e., :g:`Z`, :g:`nat`, :g:`positive` and :g:`N`. .. cmd:: Show Zify Spec .. deprecated:: 8.13 - Use instead either :cmd:`Show Zify` ``UnOpSpec`` or :cmd:`Show Zify` ``BinOpSpec``. + Use :cmd:`Show Zify` ``UnOpSpec`` or :cmd:`Show Zify` ``BinOpSpec`` instead. + +.. cmd:: Add InjTyp @one_term + + .. deprecated:: 8.13 + Use :cmd:`Add Zify` ``InjTyp`` instead. + +.. cmd:: Add BinOp @one_term + + .. deprecated:: 8.13 + Use :cmd:`Add Zify` ``BinOp`` instead. + +.. cmd:: Add BinOpSpec @one_term + + .. deprecated:: 8.13 + Use :cmd:`Add Zify` ``BinOpSpec`` instead. + +.. cmd:: Add UnOp @one_term + + .. deprecated:: 8.13 + Use :cmd:`Add Zify` ``UnOp`` instead. + +.. cmd:: Add UnOpSpec @one_term + + .. deprecated:: 8.13 + Use :cmd:`Add Zify` ``UnOpSpec`` instead. + +.. cmd:: Add CstOp @one_term + + .. deprecated:: 8.13 + Use :cmd:`Add Zify` ``CstOp`` instead. -.. cmd:: Add InjTyp +.. cmd:: Add BinRel @one_term .. deprecated:: 8.13 - Use instead either :cmd:`Add Zify` ``InjTyp``. + Use :cmd:`Add Zify` ``BinRel`` instead. -.. cmd:: Add BinOp +.. cmd:: Add PropOp @one_term .. deprecated:: 8.13 - Use instead either :cmd:`Add Zify` ``BinOp``. + Use :cmd:`Add Zify` ``PropOp`` instead. -.. cmd:: Add UnOp +.. cmd:: Add PropBinOp @one_term .. deprecated:: 8.13 - Use instead either :cmd:`Add Zify` ``UnOp``. + Use :cmd:`Add Zify` ``PropBinOp`` instead. -.. cmd:: Add CstOp +.. cmd:: Add PropUOp @one_term .. deprecated:: 8.13 - Use instead either :cmd:`Add Zify` ``CstOp``. + Use :cmd:`Add Zify` ``PropUOp`` instead. -.. cmd:: Add BinRel +.. cmd:: Add Saturate @one_term .. deprecated:: 8.13 - Use instead either :cmd:`Add Zify` ``BinRel``. + Use :cmd:`Add Zify` ``Saturate`` instead. diff --git a/doc/sphinx/addendum/miscellaneous-extensions.rst b/doc/sphinx/addendum/miscellaneous-extensions.rst index 0e8660cb0e..3944a34cdc 100644 --- a/doc/sphinx/addendum/miscellaneous-extensions.rst +++ b/doc/sphinx/addendum/miscellaneous-extensions.rst @@ -7,10 +7,10 @@ of program refinements. To use the Derive extension it must first be required with ``Require Coq.derive.Derive``. When the extension is loaded, it provides the following command: -.. cmd:: Derive @ident__1 SuchThat @type As @ident__2 +.. cmd:: Derive @ident__1 SuchThat @one_term As @ident__2 - :n:`@ident__1` can appear in :n:`@type`. This command opens a new proof - presenting the user with a goal for :n:`@type` in which the name :n:`@ident__1` is + :n:`@ident__1` can appear in :n:`@one_term`. This command opens a new proof + presenting the user with a goal for :n:`@one_term` in which the name :n:`@ident__1` is bound to an existential variable :g:`?x` (formally, there are other goals standing for the existential variables but they are shelved, as described in :tacn:`shelve`). diff --git a/doc/sphinx/addendum/nsatz.rst b/doc/sphinx/addendum/nsatz.rst index 8a64a7ed4b..85e0cb9536 100644 --- a/doc/sphinx/addendum/nsatz.rst +++ b/doc/sphinx/addendum/nsatz.rst @@ -5,8 +5,16 @@ Nsatz: tactics for proving equalities in integral domains :Author: Loïc Pottier -.. tacn:: nsatz - :name: nsatz + +To use the tactics described in this section, load the ``Nsatz`` module with the +command ``Require Import Nsatz``. Alternatively, if you prefer not to transitively depend on the +files that declare the axioms used to define the real numbers, you can +``Require Import NsatzTactic`` instead; this will still allow +:tacn:`nsatz` to solve goals defined about :math:`\mathbb{Z}`, +:math:`\mathbb{Q}` and any user-registered rings. + + +.. tacn:: nsatz {? with radicalmax := @one_term strategy := @one_term parameters := @one_term variables := @one_term } This tactic is for solving goals of the form @@ -32,13 +40,36 @@ Nsatz: tactics for proving equalities in integral domains doing automatic introductions. - You can load the ``Nsatz`` module with the command ``Require Import Nsatz``. + `radicalmax` + bound when searching for r such that + :math:`c (P−Q) r = \sum_{i=1..s} S_i (P i − Q i)`. + This argument must be of type `N` (binary natural numbers). - Alternatively, if you prefer not to transitively depend on the - files declaring the axioms used to define the real numbers, you can - ``Require Import NsatzTactic`` instead; this will still allow - :tacn:`nsatz` to solve goals defined about :math:`\mathbb{Z}`, - :math:`\mathbb{Q}` and any user-registered rings. + `strategy` + gives the order on variables :math:`X_1,\ldots,X_n` and the strategy + used in Buchberger algorithm (see :cite:`sugar` for details): + + * `strategy := 0%Z`: reverse lexicographic order and newest s-polynomial. + * `strategy := 1%Z`: reverse lexicographic order and sugar strategy. + * `strategy := 2%Z`: pure lexicographic order and newest s-polynomial. + * `strategy := 3%Z`: pure lexicographic order and sugar strategy. + + `parameters` + a list of parameters of type `R`, containing the variables :math:`X_{i_1},\ldots,X_{i_k}` among + :math:`X_1,\ldots,X_n`. Computation will be performed with + rational fractions in these parameters, i.e. polynomials have + coefficients in :math:`R(X_{i_1},\ldots,X_{i_k})`. In this case, the coefficient + :math:`c` can be a nonconstant polynomial in :math:`X_{i_1},\ldots,X_{i_k}`, and the tactic + produces a goal which states that :math:`c` is not zero. + + `variables` + a list of variables of type `R` in the decreasing order in + which they will be used in the Buchberger algorithm. If the list is empty, + then `lvar` is replaced by all the variables which are not in + `parameters`. + + See the file `Nsatz.v <https://github.com/coq/coq/blob/master/test-suite/success/Nsatz.v>`_ + for examples, especially in geometry. More about `nsatz` --------------------- @@ -63,32 +94,3 @@ Buchberger algorithm. This computation is done after a step of *reification*, which is performed using :ref:`typeclasses`. - -.. tacv:: nsatz with radicalmax:=@natural%N strategy:=@natural%Z parameters:=[{*, @ident}] variables:=[{*, @ident}] - - Most complete syntax for `nsatz`. - - * `radicalmax` is a bound when searching for r such that - :math:`c (P−Q) r = \sum_{i=1..s} S_i (P i − Q i)` - - * `strategy` gives the order on variables :math:`X_1,\ldots,X_n` and the strategy - used in Buchberger algorithm (see :cite:`sugar` for details): - - * strategy = 0: reverse lexicographic order and newest s-polynomial. - * strategy = 1: reverse lexicographic order and sugar strategy. - * strategy = 2: pure lexicographic order and newest s-polynomial. - * strategy = 3: pure lexicographic order and sugar strategy. - - * `parameters` is the list of variables :math:`X_{i_1},\ldots,X_{i_k}` among - :math:`X_1,\ldots,X_n` which are considered as parameters: computation will be performed with - rational fractions in these variables, i.e. polynomials are considered - with coefficients in :math:`R(X_{i_1},\ldots,X_{i_k})`. In this case, the coefficient - :math:`c` can be a non constant polynomial in :math:`X_{i_1},\ldots,X_{i_k}`, and the tactic - produces a goal which states that :math:`c` is not zero. - - * `variables` is the list of the variables in the decreasing order in - which they will be used in the Buchberger algorithm. If `variables` = :g:`(@nil R)`, - then `lvar` is replaced by all the variables which are not in - `parameters`. - -See the test-suite file `Nsatz.v <https://github.com/coq/coq/blob/master/test-suite/success/Nsatz.v>`_ for many examples, especially in geometry. diff --git a/doc/sphinx/addendum/omega.rst b/doc/sphinx/addendum/omega.rst index e1b1ee8e8d..35f087d47d 100644 --- a/doc/sphinx/addendum/omega.rst +++ b/doc/sphinx/addendum/omega.rst @@ -9,7 +9,7 @@ Omega: a solver for quantifier-free problems in Presburger Arithmetic The :tacn:`omega` tactic is deprecated in favor of the :tacn:`lia` tactic. The goal is to consolidate the arithmetic solving - capabilities of Coq into a single engine; moreover, :tacn:`lia` is + capabilities of |Coq| into a single engine; moreover, :tacn:`lia` is in general more powerful than :tacn:`omega` (it is a complete Presburger arithmetic solver while :tacn:`omega` was known to be incomplete). @@ -143,7 +143,7 @@ Options .. deprecated:: 8.5 - This deprecated flag (on by default) is for compatibility with Coq pre 8.5. It + This deprecated flag (on by default) is for compatibility with |Coq| pre 8.5. It resets internal name counters to make executions of :tacn:`omega` independent. .. flag:: Omega UseLocalDefs diff --git a/doc/sphinx/addendum/program.rst b/doc/sphinx/addendum/program.rst index c6a4b4fe1a..5da1ac3f46 100644 --- a/doc/sphinx/addendum/program.rst +++ b/doc/sphinx/addendum/program.rst @@ -22,7 +22,7 @@ complete |Coq| term. |Program| replaces the |Program| tactic by Catherine Parent :cite:`Parent95b` which had a similar goal but is no longer maintained. The languages available as input are currently restricted to |Coq|’s -term language, but may be extended to OCaml, Haskell and +term language, but may be extended to |OCaml|, Haskell and others in the future. We use the same syntax as |Coq| and permit to use implicit arguments and the existing coercion mechanism. Input terms and types are typed in an extended system (Russell) and interpreted @@ -33,7 +33,7 @@ obligations which need to be resolved to create the final term. .. _elaborating-programs: Elaborating programs ---------------------- +-------------------- The main difference from |Coq| is that an object in a type :g:`T : Set` can be considered as an object of type :g:`{x : T | P}` for any well-formed @@ -83,7 +83,7 @@ coercions. .. flag:: Program Cases - This controls the special treatment of pattern matching generating equalities + Controls the special treatment of pattern matching generating equalities 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 flag is @@ -91,7 +91,7 @@ coercions. .. flag:: Program Generalized Coercion - This controls the coercion of general inductive types when using |Program| + Controls the coercion of general inductive types when using |Program| (the flag is on by default). Coercion of subset types and pairs is still active in this case. @@ -104,16 +104,16 @@ coercions. typechecking. .. attr:: program + :name: program; Program - This attribute allows to use the Program mode on a specific + Allows using the Program mode on a specific definition. An alternative syntax is to use the legacy ``Program`` - prefix (cf. :n:`@legacy_attr`) as documented in the rest of this - chapter. + prefix (cf. :n:`@legacy_attr`) as it is elsewhere in this chapter. .. _syntactic_control: Syntactic control over equalities -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To give more control over the generation of equalities, the type checker will fall back directly to |Coq|’s usual typing of dependent @@ -158,36 +158,20 @@ prove some goals to construct the final definitions. Program Definition ~~~~~~~~~~~~~~~~~~ -.. cmd:: Program Definition @ident := @term - - This command types the value term in Russell and generates proof - obligations. Once solved using the commands shown below, it binds the - final |Coq| term to the name :n:`@ident` in the environment. - - .. exn:: @ident already exists. - :name: @ident already exists. (Program Definition) - :undocumented: - - .. cmdv:: Program Definition @ident : @type := @term - - It interprets the type :n:`@type`, potentially generating proof - obligations to be resolved. Once done with them, we have a |Coq| - type :n:`@type__0`. It then elaborates the preterm :n:`@term` into a |Coq| - term :n:`@term__0`, checking that the type of :n:`@term__0` is coercible to - :n:`@type__0`, and registers :n:`@ident` as being of type :n:`@type__0` once the - set of obligations generated during the interpretation of :n:`@term__0` - and the aforementioned coercion derivation are solved. - - .. exn:: In environment … the term: @term does not have type @type. Actually, it has type ... - :undocumented: +A :cmd:`Definition` command with the :attr:`program` attribute types +the value term in Russell and generates proof +obligations. Once solved using the commands shown below, it binds the +final |Coq| term to the name :n:`@ident` in the environment. - .. cmdv:: Program Definition @ident {* @binder } : @type := @term +:n:`Program Definition @ident : @type := @term` - This is equivalent to: - - :n:`Program Definition @ident : forall {* @binder }, @type := fun {* @binder } => @term`. - - .. TODO refer to production in alias +Interprets the type :n:`@type`, potentially generating proof +obligations to be resolved. Once done with them, we have a |Coq| +type :n:`@type__0`. It then elaborates the preterm :n:`@term` into a |Coq| +term :n:`@term__0`, checking that the type of :n:`@term__0` is coercible to +:n:`@type__0`, and registers :n:`@ident` as being of type :n:`@type__0` once the +set of obligations generated during the interpretation of :n:`@term__0` +and the aforementioned coercion derivation are solved. .. seealso:: Sections :ref:`vernac-controlling-the-reduction-strategies`, :tacn:`unfold` @@ -196,20 +180,8 @@ Program Definition Program Fixpoint ~~~~~~~~~~~~~~~~ -.. cmd:: Program Fixpoint @fix_definition {* with @fix_definition } - - The optional :n:`@fixannot` annotation can be one of: - - + :g:`measure f R` where :g:`f` is a value of type :g:`X` computed on - any subset of the arguments and the optional term - :g:`R` is a relation on :g:`X`. :g:`X` defaults to :g:`nat` and :g:`R` - to :g:`lt`. - - + :g:`wf R x` which is equivalent to :g:`measure x R`. - - The structural fixpoint operator behaves just like the one of |Coq| (see - :cmd:`Fixpoint`), except it may also generate obligations. It works - with mutually recursive definitions too. +A :cmd:`Fixpoint` command with the :attr:`program` attribute may also generate obligations. It works +with mutually recursive definitions too. For example: .. coqtop:: reset in @@ -223,6 +195,17 @@ Program Fixpoint | _ => O end. +The :cmd:`Fixpoint` command may include an optional :n:`@fixannot` annotation, which can be: + ++ :g:`measure f R` where :g:`f` is a value of type :g:`X` computed on + any subset of the arguments and the optional term + :g:`R` is a relation on :g:`X`. :g:`X` defaults to :g:`nat` and :g:`R` + to :g:`lt`. + ++ :g:`wf R x` which is equivalent to :g:`measure x R`. + +.. todo see https://github.com/coq/coq/pull/12936#discussion_r492747830 + Here we have one obligation for each branch (branches for :g:`0` and ``(S 0)`` are automatically generated by the pattern matching compilation algorithm). @@ -246,8 +229,6 @@ using the syntax: | _ => O end. - - .. caution:: When defining structurally recursive functions, the generated obligations should have the prototype of the currently defined functional in their context. In this case, the obligations should be @@ -266,67 +247,70 @@ using the syntax: Program Lemma ~~~~~~~~~~~~~ -.. cmd:: Program Lemma @ident : @type - - The Russell language can also be used to type statements of logical - properties. It will generate obligations, try to solve them - automatically and fail if some unsolved obligations remain. In this - case, one can first define the lemma’s statement using :g:`Program - Definition` and use it as the goal afterwards. Otherwise the proof - will be started with the elaborated version as a goal. The - :g:`Program` prefix can similarly be used as a prefix for - :g:`Variable`, :g:`Hypothesis`, :g:`Axiom` etc. +A :cmd:`Lemma` command with the :attr:`program` attribute uses the Russell +language to type statements of logical +properties. It generates obligations, tries to solve them +automatically and fails if some unsolved obligations remain. In this +case, one can first define the lemma’s statement using :cmd:`Definition` +and use it as the goal afterwards. Otherwise the proof +will be started with the elaborated version as a goal. The +:attr:`Program` attribute can similarly be used with +:cmd:`Variable`, :cmd:`Hypothesis`, :cmd:`Axiom` etc. .. _solving_obligations: Solving obligations --------------------- +------------------- The following commands are available to manipulate obligations. The optional identifier is used when multiple functions have unsolved obligations (e.g. when defining mutually recursive blocks). The optional tactic is replaced by the default one if not specified. -.. cmd:: {? {| Local | Global } } Obligation Tactic := @ltac_expr +.. cmd:: Obligation Tactic := @ltac_expr :name: Obligation Tactic Sets the default obligation solving tactic applied to all obligations automatically, whether to solve them or when starting to prove one, - e.g. using :g:`Next`. :g:`Local` makes the setting last only for the current - module. Inside sections, local is the default. + e.g. using :cmd:`Next Obligation`. + + This command supports the :attr:`local` and :attr:`global` attributes. + :attr:`local` makes the setting last only for the current + module. :attr:`local` is the default inside sections while :attr:`global` + otherwise. .. cmd:: Show Obligation Tactic Displays the current default tactic. -.. cmd:: Obligations {? of @ident} +.. cmd:: Obligations {? of @ident } Displays all remaining obligations. -.. cmd:: Obligation @natural {? of @ident} +.. cmd:: Obligation @natural {? of @ident } {? : @type {? with @ltac_expr } } Start the proof of obligation :token:`natural`. -.. cmd:: Next Obligation {? of @ident} +.. cmd:: Next Obligation {? of @ident } {? with @ltac_expr } Start the proof of the next unsolved obligation. -.. cmd:: Solve Obligations {? {? of @ident} with @ltac_expr} +.. cmd:: Solve Obligations {? of @ident } {? with @ltac_expr } - Tries to solve each obligation of ``ident`` using the given ``tactic`` or the default one. + Tries to solve each obligation of :token:`ident` using the given :token:`ltac_expr` or the default one. -.. cmd:: Solve All Obligations {? with @ltac_expr} +.. cmd:: Solve All Obligations {? with @ltac_expr } Tries to solve each obligation of every program using the given tactic or the default one (useful for mutually recursive definitions). -.. cmd:: Admit Obligations {? of @ident} +.. cmd:: Admit Obligations {? of @ident } - Admits all obligations (of ``ident``). + Admits all obligations (of :token:`ident`). .. note:: Does not work with structurally recursive programs. -.. cmd:: Preterm {? of @ident} +.. cmd:: Preterm {? of @ident } Shows the term that will be fed to the kernel once the obligations are solved. Useful for debugging. diff --git a/doc/sphinx/addendum/ring.rst b/doc/sphinx/addendum/ring.rst index cda8a1b679..da1a393b4a 100644 --- a/doc/sphinx/addendum/ring.rst +++ b/doc/sphinx/addendum/ring.rst @@ -99,10 +99,10 @@ Yes, building the variables map and doing the substitution after normalizing is automatically done by the tactic. So you can just forget this paragraph and use the tactic according to your intuition. -Concrete usage in Coq +Concrete usage in |Coq| -------------------------- -.. tacn:: ring {? [ {+ @term } ] } +.. tacn:: ring {? [ {+ @one_term } ] } Solves polynomical equations of a ring (or semiring) structure. It proceeds by normalizing both sides @@ -110,14 +110,35 @@ Concrete usage in Coq distributivity, constant propagation, rewriting of monomials) and syntactically comparing the results. -.. tacn:: ring_simplify {? [ {+ @term } ] } {+ @term } {? in @ident } + :n:`[ {+ @one_term } ]` + If specified, the tactic decides the equality of two terms modulo ring operations and + the equalities defined by the :token:`one_term`\s. + Each :token:`one_term` has to be a proof of some equality :g:`m = p`, where :g:`m` + is a monomial (after “abstraction”), :g:`p` a polynomial and :g:`=` is the + corresponding equality of the ring structure. + +.. tacn:: ring_simplify {? [ {+ @one_term } ] } {+ @one_term } {? in @ident } Applies the normalization procedure described above to - the given terms. The tactic then replaces all occurrences of the terms - given in the conclusion of the goal by their normal forms. If no term + the given :token:`one_term`\s. The tactic then replaces all occurrences of the :token:`one_term`\s + given in the conclusion of the goal by their normal forms. If no :token:`one_term` is given, then the conclusion should be an equation and both sides are normalized. The tactic can also be applied in a hypothesis. + :n:`in @ident` + If specified, the tactic performs the simplification in the hypothesis named :token:`ident`. + + .. note:: + + :n:`ring_simplify @one_term__1; ring_simplify @one_term__2` is not equivalent to + :n:`ring_simplify @one_term__1 @one_term__2`. + + In the latter case the variables map is shared between the two :token:`one_term`\s, and + common subterm :g:`t` of :n:`@one_term__1` and :n:`@one_term__2` + will have the same associated variable number. So the first + alternative should be avoided for :token:`one_term`\s belonging to the same ring + theory. + The tactic must be loaded by ``Require Import Ring``. The ring structures must be declared with the ``Add Ring`` command (see below). The ring of booleans is predefined; if one wants to use the tactic on |nat| one must @@ -147,31 +168,6 @@ Concrete usage in Coq Abort. -.. tacv:: ring [{* @term }] - - This tactic decides the equality of two terms modulo ring operations and - the equalities defined by the :token:`term`\ s. - Each :token:`term` has to be a proof of some equality :g:`m = p`, where :g:`m` - is a monomial (after “abstraction”), :g:`p` a polynomial and :g:`=` the - corresponding equality of the ring structure. - -.. tacv:: ring_simplify [{* @term }] {* @term } in @ident - - This tactic performs the simplification in the hypothesis named :token:`ident`. - - -.. note:: - - :n:`ring_simplify @term__1; ring_simplify @term__2` is not equivalent to - :n:`ring_simplify @term__1 @term__2`. - - In the latter case the variables map is shared between the two terms, and - common subterm :g:`t` of :n:`@term__1` and :n:`@term__2` - will have the same associated variable number. So the first - alternative should be avoided for terms belonging to the same ring - theory. - - Error messages: @@ -433,10 +429,10 @@ How does it work? The code of ``ring`` is a good example of a tactic written using *reflection*. What is reflection? Basically, using it means that a part of a tactic is written -in Gallina, Coq's language of terms, rather than |Ltac| or |OCaml|. From the +in Gallina, |Coq|'s language of terms, rather than |Ltac| or |OCaml|. From the philosophical point of view, reflection is using the ability of the Calculus of Constructions to speak and reason about itself. For the ``ring`` tactic we used -Coq as a programming language and also as a proof environment to build a tactic +|Coq| as a programming language and also as a proof environment to build a tactic and to prove its correctness. The interested reader is strongly advised to have a look at the @@ -515,15 +511,27 @@ application of the main correctness theorem to well-chosen arguments. Dealing with fields ------------------------ -.. tacn:: field {? [ {+ @term } ] } +.. tacn:: field {? [ {+ @one_term } ] } - This tactic is an extension of the :tacn:`ring` tactic that deals with rational + An extension of the :tacn:`ring` tactic that deals with rational expressions. Given a rational expression :math:`F = 0`. It first reduces the expression `F` to a common denominator :math:`N/D = 0` where `N` and `D` are two ring expressions. For example, if we take :math:`F = (1 − 1/x) x − x + 1`, this gives :math:`N = (x − 1) x − x^2 + x` and :math:`D = x`. It then calls ring to solve :math:`N = 0`. + :n:`[ {+ @one_term } ]` + If specified, the tactic decides the equality of two terms modulo + field operations and the equalities defined + by the :token:`one_term`\s. Each :token:`one_term` has to be a proof of some equality + :g:`m = p`, where :g:`m` is a monomial (after “abstraction”), :g:`p` a polynomial + and :g:`=` the corresponding equality of the field structure. + + .. note:: + + Rewriting works with the equality :g:`m = p` only if :g:`p` is a polynomial since + rewriting is handled by the underlying ring tactic. + Note that :n:`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 @@ -559,71 +567,36 @@ Dealing with fields intros x y H H1; field [H1]; auto. Abort. -.. tacv:: field [{* @term}] - - This tactic decides the equality of two terms modulo - field operations and the equalities defined - by the :token:`term`\s. Each :token:`term` has to be a proof of some equality - :g:`m = p`, where :g:`m` is a monomial (after “abstraction”), :g:`p` a polynomial - and :g:`=` the corresponding equality of the field structure. - -.. note:: - - Rewriting works with the equality :g:`m = p` only if :g:`p` is a polynomial since - rewriting is handled by the underlying ring tactic. - -.. tacn:: field_simplify {? [ {+ @term } ] } {+ @term } {? in @ident } +.. tacn:: field_simplify {? [ {+ @one_term__eq } ] } {+ @one_term } {? in @ident } - performs the simplification in the conclusion of the + Performs the simplification in the conclusion of the goal, :math:`F_1 = F_2` becomes :math:`N_1 / D_1 = N_2 / D_2`. A normalization step (the same as the one for rings) is then applied to :math:`N_1`, :math:`D_1`, :math:`N_2` and :math:`D_2`. This way, polynomials remain in factorized form during fraction simplification. This yields smaller expressions when reducing to the same denominator since common factors can be canceled. -.. tacv:: field_simplify [{* @term }] - - This variant performs the simplification in the conclusion of the goal using the equalities - defined by the :token:`term`\s. - -.. tacv:: field_simplify [{* @term }] {* @term } - - This variant performs the simplification in the terms :token:`term`\s of the conclusion of the goal - using the equalities defined by :token:`term`\s inside the brackets. - -.. tacv:: field_simplify in @ident - - This variant performs the simplification in the assumption :token:`ident`. - -.. tacv:: field_simplify [{* @term }] in @ident - - This variant performs the simplification - in the assumption :token:`ident` using the equalities defined by the :token:`term`\s. - -.. tacv:: field_simplify [{* @term }] {* @term } in @ident - - This variant performs the simplification in the :token:`term`\s of the - assumption :token:`ident` using the - equalities defined by the :token:`term`\s inside the brackets. - -.. tacn:: field_simplify_eq {? [ {+ @term } ] } {? in @ident } - - performs the simplification in the conclusion of - the goal removing the denominator. :math:`F_1 = F_2` becomes :math:`N_1 D_2 = N_2 D_1`. + :n:`[ {+ @one_term__eq } ]` + Do simplification in the conclusion of the goal using the equalities + defined by these :token:`one_term`\s. -.. tacv:: field_simplify_eq [ {* @term }] + :n:`{+ @one_term }` + Terms to simplify in the conclusion. - This variant performs the simplification in - the conclusion of the goal using the equalities defined by :token:`term`\s. + :n:`in @ident` + If specified, substitute in the hypothesis :n:`@ident` instead of the conclusion. -.. tacv:: field_simplify_eq in @ident +.. tacn:: field_simplify_eq {? [ {+ @one_term } ] } {? in @ident } - This variant performs the simplification in the assumption :token:`ident`. + Performs the simplification in the conclusion of + the goal, removing the denominator. :math:`F_1 = F_2` becomes :math:`N_1 D_2 = N_2 D_1`. -.. tacv:: field_simplify_eq [{* @term}] in @ident + :n:`[ {+ @one_term } ]` + Do simplification in the conclusion of the goal using the equalities + defined by these :token:`one_term`\s. - This variant performs the simplification in the assumption :token:`ident` - using the equalities defined by :token:`term`\s and removing the denominator. + :n:`in @ident` + If specified, simplify in the hypothesis :n:`@ident` instead of the conclusion. Adding a new field structure diff --git a/doc/sphinx/addendum/type-classes.rst b/doc/sphinx/addendum/type-classes.rst index d533470f22..7638fce010 100644 --- a/doc/sphinx/addendum/type-classes.rst +++ b/doc/sphinx/addendum/type-classes.rst @@ -13,7 +13,7 @@ Class and Instance declarations ------------------------------- The syntax for class and instance declarations is the same as the record -syntax of Coq: +syntax of |Coq|: .. coqdoc:: @@ -61,7 +61,7 @@ Note that if you finish the proof with :cmd:`Qed` the entire instance will be opaque, including the fields given in the initial term. Alternatively, in :flag:`Program Mode` if one does not give all the -members in the Instance declaration, Coq generates obligations for the +members in the Instance declaration, |Coq| generates obligations for the remaining fields, e.g.: .. coqtop:: in @@ -242,7 +242,7 @@ binders. For example: Definition lt `{eqa : EqDec A, ! Ord eqa} (x y : A) := andb (le x y) (neqb x y). The ``!`` modifier switches the way a binder is parsed back to the usual -interpretation of Coq. In particular, it uses the implicit arguments +interpretation of |Coq|. In particular, it uses the implicit arguments mechanism if available, as shown in the example. Substructures @@ -295,10 +295,29 @@ the Existing Instance command to achieve the same effect. Summary of the commands ----------------------- -.. cmd:: Class @inductive_definition {* with @inductive_definition } +.. cmd:: Class @record_definition + Class @singleton_class_definition - The :cmd:`Class` command is used to declare a typeclass with parameters - :n:`{* @binder }` and fields the declared record fields. + .. insertprodn singleton_class_definition singleton_class_definition + + .. prodn:: + singleton_class_definition ::= {? > } @ident_decl {* @binder } {? : @sort } := @constructor + + The first form declares a record and makes the record a typeclass with parameters + :n:`{* @binder }` and the listed record fields. + + .. _singleton-class: + + The second form declares a *singleton* class with a single method. This + singleton class is a so-called definitional class, represented simply + as a definition ``ident binders := term`` and whose instances are + themselves objects of this type. Definitional classes are not wrapped + inside records, and the trivial projection of an instance of such a + class is convertible to the instance itself. This can be useful to + make instances of existing objects easily and to reduce proof size by + not inserting useless projections. The class constant itself is + declared rigid during resolution so that the class abstraction is + maintained. Like any command declaring a record, this command supports the :attr:`universes(polymorphic)`, :attr:`universes(monomorphic)`, @@ -306,22 +325,7 @@ Summary of the commands :attr:`universes(cumulative)`, :attr:`universes(noncumulative)` and :attr:`private(matching)` attributes. - .. _singleton-class: - - .. cmdv:: Class @ident {* @binder } : {? @sort} := @ident : @term - - This variant declares a *singleton* class with a single method. This - singleton class is a so-called definitional class, represented simply - as a definition ``ident binders := term`` and whose instances are - themselves objects of this type. Definitional classes are not wrapped - inside records, and the trivial projection of an instance of such a - class is convertible to the instance itself. This can be useful to - make instances of existing objects easily and to reduce proof size by - not inserting useless projections. The class constant itself is - declared rigid during resolution so that the class abstraction is - maintained. - - .. cmdv:: Existing Class @ident + .. cmd:: Existing Class @qualid This variant declares a class from a previously declared constant or inductive definition. No methods or instances are defined. @@ -330,27 +334,31 @@ Summary of the commands This command has no effect when used on a typeclass. -.. cmd:: Instance @ident {* @binder } : @term__0 {+ @term} {? | @natural} := { {*; @field_def} } +.. cmd:: Instance {? @ident_decl {* @binder } } : @type {? @hint_info } {? {| := %{ {* @field_def } %} | := @term } } + + .. insertprodn hint_info hint_info - This command is used to declare a typeclass instance named - :token:`ident` of the class :n:`@term__0` with parameters :token:`term` and + .. prodn:: + hint_info ::= %| {? @natural } {? @one_term } + + Declares a typeclass instance named + :token:`ident_decl` of the class :n:`@type` with the specified parameters and with fields defined by :token:`field_def`, where each field must be a declared field of the class. - An arbitrary context of :n:`{* @binder }` 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 - :tacn:`auto` hints. If the priority :token:`natural` is not specified, it defaults to the number + Add one or more :token:`binder`\s to declare a parameterized instance. :token:`hint_info` + specifies the hint priority, where 0 is the highest priority as for + :tacn:`auto` hints. If the priority is not specified, the default is the number of non-dependent binders of the instance. This command supports the :attr:`global` attribute that can be used on instances declared in a section so that their - generalization is automatically redeclared after the section is + generalization is automatically redeclared when the section is closed. Like :cmd:`Definition`, it also supports the :attr:`program` attribute to switch the type checking to `Program` (chapter - :ref:`programs`) and use the obligation mechanism to manage missing + :ref:`programs`) and to use the obligation mechanism to manage missing fields. Finally, it supports the lighter :attr:`refine` attribute: @@ -362,67 +370,43 @@ Summary of the commands to fill them. It works exactly as if no body had been given and the :tacn:`refine` tactic has been used first. - .. cmdv:: Instance @ident {* @binder } : forall {* @binder }, @term__0 {+ @term} {? | @natural } := @term - - This syntax is used for declaration of singleton class instances or - for directly giving an explicit term of type :n:`forall {* @binder }, @term__0 - {+ @term}`. One need not even mention the unique field name for - singleton classes. - - .. cmdv:: Declare Instance - :name: Declare Instance + .. cmd:: Declare Instance @ident_decl {* @binder } : @term {? @hint_info } - In a :cmd:`Module Type`, this command states that a corresponding concrete + In a :cmd:`Module Type`, declares that a corresponding concrete instance should exist in any implementation of this :cmd:`Module Type`. This is similar to the distinction between :cmd:`Parameter` vs. :cmd:`Definition`, or between :cmd:`Declare Module` and :cmd:`Module`. -Besides the :cmd:`Class` and :cmd:`Instance` vernacular commands, there are a -few other commands related to typeclasses. + .. cmd:: Existing Instance @qualid {? @hint_info } + Existing Instances {+ @qualid } {? %| @natural } + + Adds a constant whose type ends with + an applied typeclass to the instance database with an optional + priority :token:`natural`. 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 + registers instances for :cmd:`Print Instances`. + +.. cmd:: Print Instances @reference -.. cmd:: Existing Instance {+ @ident} {? | @natural} + Shows the list of instances associated with the typeclass :token:`reference`. - This command adds an arbitrary list of constants whose type ends with - an applied typeclass to the instance database with an optional - priority :token:`natural`. 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 - registers instances for :cmd:`Print Instances`. -.. tacn:: typeclasses eauto - :name: typeclasses eauto +.. tacn:: typeclasses eauto {? bfs } {? @int_or_var } {? with {+ @ident } } - This proof search tactic implements the resolution engine that is run + This proof search tactic uses the resolution engine that is run implicitly during type checking. This tactic uses a different resolution engine than :tacn:`eauto` and :tacn:`auto`. The main differences are the following: - + 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 + + Unlike :tacn:`eauto` and :tacn:`auto`, the resolution is done entirely in + the proof engine, meaning that backtracking is available among dependent subgoals, and shelving goals is supported. ``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 - 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). - - .. note:: - As of Coq 8.6, ``all:once (typeclasses eauto)`` faithfully - mimics what happens during typeclass resolution when it is called - 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`` - allows shelved goals to remain at any point during search and treat - typeclass goals like any other. - + The transparency information of databases is used consistently for all hints declared in them. It is always used when calling the unifier. When considering local hypotheses, we use the transparent @@ -446,26 +430,44 @@ few other commands related to typeclasses. + When considering local hypotheses, we use the union of all the modes declared in the given databases. - .. tacv:: typeclasses eauto @natural + + Use the :cmd:`Typeclasses eauto` command to customize the behavior of + this tactic. - .. warning:: - The semantics for the limit :n:`@natural` - 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 with :tacn:`auto`. + :n:`@int_or_var` + Specifies the maximum depth of the search. - .. tacv:: typeclasses eauto with {+ @ident} + .. warning:: + The semantics for the limit :n:`@int_or_var` + are different than for :tacn:`auto`. By default, if no limit is given, the + search is unbounded. Unlike :tacn:`auto`, introduction steps count against + the limit, which might result in larger limits being necessary when + searching with :tacn:`typeclasses eauto` than with :tacn:`auto`. + + :n:`with {+ @ident }` + Runs resolution with the specified hint databases. It treats + typeclass subgoals the same as other subgoals (no shelving of + non-typeclass goals in particular), while allowing shelved goals + to remain at any point during search. + + When :n:`with` is not specified, :tacn:`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). - This variant runs resolution with the given hint databases. It treats - typeclass subgoals the same as other subgoals (no shelving of - non-typeclass goals in particular). + .. note:: + ``all:once (typeclasses eauto)`` faithfully + mimics what happens during typeclass resolution when it is called + 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. -.. tacn:: autoapply @term with @ident +.. tacn:: autoapply @one_term with @ident :name: autoapply - The tactic ``autoapply`` applies a term using the transparency information - of the hint database ident, and does *no* typeclass resolution. This can + The tactic ``autoapply`` applies :token:`one_term` using the transparency information + of the hint database :token:`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 typeclass @@ -476,16 +478,16 @@ few other commands related to typeclasses. Typeclasses Transparent, Typeclasses Opaque ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.. cmd:: Typeclasses Transparent {+ @ident} +.. cmd:: Typeclasses Transparent {+ @qualid } - This command makes the identifiers transparent during typeclass + Makes :token:`qualid` transparent during typeclass resolution. - Shortcut for :n:`Hint Transparent {+ @ident } : typeclass_instances`. + A shortcut for :cmd:`Hint Transparent` :n:`{+ @qualid } : typeclass_instances` -.. cmd:: Typeclasses Opaque {+ @ident} +.. cmd:: Typeclasses Opaque {+ @qualid } - Make the identifiers opaque for typeclass search. - Shortcut for :n:`Hint Opaque {+ @ident } : typeclass_instances`. + Make :token:`qualid` opaque for typeclass search. + A shortcut for :cmd:`Hint Opaque` :n:`{+ @qualid } : typeclass_instances`. It is useful when some constants prevent some unifications and make resolution fail. It is also useful to declare constants which @@ -511,13 +513,13 @@ Settings This flag (off by default) respects the dependency order between subgoals, meaning that subgoals on which other subgoals depend come first, while the non-dependent subgoals were put before - the dependent ones previously (Coq 8.5 and below). This can result in + the dependent ones previously (|Coq| 8.5 and below). This can result in quite different performance behaviors of proof search. .. flag:: Typeclasses Filtered Unification - This flag, available since Coq 8.6 and off by default, switches the + This flag, which is off by default, switches the hint application procedure to a filter-then-unify strategy. To apply a hint, we first check that the goal *matches* syntactically the inferred or specified pattern of the hint, and only then try to @@ -601,22 +603,25 @@ Settings of goals. Setting this option to 1 or 2 turns on the :flag:`Typeclasses Debug` flag; setting this option to 0 turns that flag off. -Typeclasses eauto `:=` -~~~~~~~~~~~~~~~~~~~~~~ +Typeclasses eauto +~~~~~~~~~~~~~~~~~ -.. cmd:: Typeclasses eauto := {? debug} {? {| (dfs) | (bfs) } } @natural +.. cmd:: Typeclasses eauto := {? debug } {? ( {| bfs | dfs } ) } {? @natural } :name: Typeclasses eauto - This command allows more global customization of the typeclass - resolution tactic. The semantics of the options are: + Allows more global customization of the :tacn:`typeclasses eauto` tactic. + The options are: - + ``debug`` This sets the debug mode. In debug mode, the trace of - successfully applied tactics is printed. The debug mode can also + ``debug`` + Sets debug mode. In debug mode, a trace of + successfully applied tactics is printed. Debug mode can also be set with :flag:`Typeclasses Debug`. - + ``(dfs)``, ``(bfs)`` This sets the search strategy to depth-first + ``dfs``, ``bfs`` + Sets the search strategy to depth-first search (the default) or breadth-first search. The search strategy can also be set with :flag:`Typeclasses Iterative Deepening`. - + :token:`natural` This sets the depth limit of the search. The depth - limit can also be set with :opt:`Typeclasses Depth`. + :token:`natural` + Sets the depth limit for the search. The limit can also be set with + :opt:`Typeclasses Depth`. diff --git a/doc/sphinx/addendum/universe-polymorphism.rst b/doc/sphinx/addendum/universe-polymorphism.rst index b0ef792bd1..dd26534ec7 100644 --- a/doc/sphinx/addendum/universe-polymorphism.rst +++ b/doc/sphinx/addendum/universe-polymorphism.rst @@ -123,6 +123,7 @@ Polymorphic, Monomorphic ------------------------- .. attr:: universes(polymorphic) + :name: universes(polymorphic); Polymorphic This attribute can be used to declare universe polymorphic definitions and inductive types. There is also a legacy syntax @@ -136,6 +137,7 @@ Polymorphic, Monomorphic used. .. attr:: universes(monomorphic) + :name: universes(monomorphic); Monomorphic This attribute can be used to declare universe monomorphic definitions and inductive types (i.e. global universe constraints @@ -170,6 +172,7 @@ Cumulative, NonCumulative ------------------------- .. attr:: universes(cumulative) + :name: universes(cumulative); Cumulative Polymorphic inductive types, coinductive types, variants and records can be declared cumulative using this attribute or the @@ -200,6 +203,7 @@ Cumulative, NonCumulative effect on *monomorphic* inductive definitions. .. attr:: universes(noncumulative) + :name: universes(noncumulative); NonCumulative Declares the inductive type as non-cumulative even if the :flag:`Polymorphic Inductive Cumulativity` flag is on. There is @@ -384,29 +388,26 @@ Explicit Universes The syntax has been extended to allow users to explicitly bind names to universes and explicitly instantiate polymorphic definitions. -.. cmd:: Universe @ident - Polymorphic Universe @ident +.. cmd:: Universe {+ @ident } - In the monorphic case, this command declares a new global universe - named :token:`ident`, which can be referred to using its qualified name - as well. Global universe names live in a separate namespace. The - command supports the :attr:`universes(polymorphic)` attribute (or - the ``Polymorphic`` prefix) only in sections, meaning the universe - quantification will be discharged on each section definition + In the monomorphic case, declares new global universes + with the given names. Global universe names live in a separate namespace. + The command supports the :attr:`universes(polymorphic)` attribute (or + the ``Polymorphic`` legacy attribute) only in sections, meaning the universe + quantification will be discharged for each section definition independently. .. exn:: Polymorphic universes can only be declared inside sections, use Monomorphic Universe instead. :undocumented: -.. cmd:: Constraint @univ_constraint - Polymorphic Constraint @univ_constraint +.. cmd:: Constraint {+, @univ_constraint } - This command declares a new constraint between named universes. + Declares new constraints between named universes. - If consistent, the constraint is then enforced in the global + If consistent, the constraints are then enforced in the global environment. Like :cmd:`Universe`, it can be used with the :attr:`universes(polymorphic)` attribute (or the ``Polymorphic`` - prefix) in sections only to declare constraints discharged at + legacy attribute) in sections only to declare constraints discharged at section closing time. One cannot declare a global constraint on polymorphic universes. diff --git a/doc/sphinx/appendix/history-and-changes/index.rst b/doc/sphinx/appendix/history-and-changes/index.rst index 50ffec8e3f..b00a7cdb08 100644 --- a/doc/sphinx/appendix/history-and-changes/index.rst +++ b/doc/sphinx/appendix/history-and-changes/index.rst @@ -5,10 +5,10 @@ History and recent changes ========================== This chapter is divided in two parts. The first one is about the -:ref:`early history of Coq <history>` and is presented in +:ref:`early history of |Coq| <history>` and is presented in chronological order. The second one provides :ref:`release notes -about recent versions of Coq <changes>` and is presented in reverse -chronological order. When updating your copy of Coq to a new version +about recent versions of |Coq| <changes>` and is presented in reverse +chronological order. When updating your copy of |Coq| to a new version (especially a new major version), it is strongly recommended that you read the corresponding release notes. They may contain advice that will help you understand the differences with the previous version and diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst index af66efa95e..5bc229954f 100644 --- a/doc/sphinx/changes.rst +++ b/doc/sphinx/changes.rst @@ -34,10 +34,10 @@ The main changes include: this takes precedence over the now deprecated :ref:`ssreflect search<812SSRSearch>`. - Many additions and improvements of the :ref:`standard library<812Stdlib>`. - Improvements to the :ref:`reference manual<812Refman>` include a more logical organization - of chapters along with updated syntax descriptions that match Coq's grammar + of chapters along with updated syntax descriptions that match |Coq|'s grammar in most but not all chapters. -Additionally, the :tacn:`omega` tactic is deprecated in this version of Coq, +Additionally, the :tacn:`omega` tactic is deprecated in this version of |Coq|, and we recommend users to switch to :tacn:`lia` in new proof scripts (see also the warning message in the :ref:`corresponding chapter <omega_chapter>`). @@ -46,7 +46,7 @@ See the `Changes in 8.12+beta1`_ section and following sections for the detailed list of changes, including potentially breaking changes marked with **Changed**. -Coq's documentation is available at https://coq.github.io/doc/v8.12/refman (reference +|Coq|'s documentation is available at https://coq.github.io/doc/v8.12/refman (reference manual), and https://coq.github.io/doc/v8.12/stdlib (documentation of the standard library). Developer documentation of the ML API is available at https://coq.github.io/doc/v8.12/api. @@ -55,8 +55,8 @@ Maxime Dénès, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Michael Soegtrop and Théo Zimmermann worked on maintaining and improving the continuous integration system and package building infrastructure. -Erik Martin-Dorel has maintained the `Coq Docker images -<https://hub.docker.com/r/coqorg/coq>`_ that are used in many Coq +Erik Martin-Dorel has maintained the `|Coq| Docker images +<https://hub.docker.com/r/coqorg/coq>`_ that are used in many |Coq| projects for continuous integration. The OPAM repository for |Coq| packages has been maintained by @@ -64,7 +64,7 @@ Guillaume Claret, Karl Palmskog, Matthieu Sozeau and Enrico Tassi with contributions from many users. A list of packages is available at https://coq.inria.fr/opam/www/. -Previously, most components of Coq had a single principal maintainer. +Previously, most components of |Coq| had a single principal maintainer. This was changed in 8.12 (`#11295 <https://github.com/coq/coq/pull/11295>`_) so that every component now has a team of maintainers, who are in charge of reviewing and @@ -99,12 +99,12 @@ Nickolai Zeldovich and Théo Zimmermann. Many power users helped to improve the design of this new version via the GitHub issue and pull request system, the |Coq| development mailing list coqdev@inria.fr, the coq-club@inria.fr mailing list, the `Discourse forum -<https://coq.discourse.group/>`_ and the new `Coq Zulip chat <http://coq.zulipchat.com>`_ +<https://coq.discourse.group/>`_ and the new `|Coq| Zulip chat <http://coq.zulipchat.com>`_ (thanks to Cyril Cohen for organizing the move from Gitter). Version 8.12's development spanned 6 months from the release of |Coq| 8.11.0. Emilio Jesus Gallego Arias and Théo Zimmermann are -the release managers of Coq 8.12. This release is the result of +the release managers of |Coq| 8.12. This release is the result of ~500 PRs merged, closing ~100 issues. | Nantes, June 2020, @@ -131,7 +131,7 @@ Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** - The deprecation warning raised since Coq 8.10 when a trailing + The deprecation warning raised since |Coq| 8.10 when a trailing implicit is declared to be non-maximally inserted (with the command :cmd:`Arguments`) has been turned into an error (`#11368 <https://github.com/coq/coq/pull/11368>`_, @@ -432,7 +432,7 @@ Tactics fixes `#12210 <https://github.com/coq/coq/issues/12210>`_). - **Fixed:** :tacn:`zify` now handles :g:`Z.pow_pos` by default. - In Coq 8.11, this was the case only when loading module + In |Coq| 8.11, this was the case only when loading module :g:`ZifyPow` because this triggered a regression of :tacn:`lia`. The regression is now fixed, and the module kept only for compatibility (`#11362 <https://github.com/coq/coq/pull/11362>`_, @@ -532,7 +532,7 @@ Flags, options and attributes by Emilio Jesus Gallego Arias). - **Removed:** Unqualified ``polymorphic``, ``monomorphic``, ``template``, - ``notemplate`` attributes (they were deprecated since Coq 8.10). + ``notemplate`` attributes (they were deprecated since |Coq| 8.10). Use :attr:`universes(polymorphic)`, :attr:`universes(monomorphic)`, :attr:`universes(template)` and :attr:`universes(notemplate)` instead (`#11663 <https://github.com/coq/coq/pull/11663>`_, by Théo Zimmermann). @@ -676,7 +676,7 @@ Tools involving ``%``) (`#12126 <https://github.com/coq/coq/pull/12126>`_, by Jason Gross). - **Changed:** - When passing ``TIMED=1`` to ``make`` with either Coq's own makefile + When passing ``TIMED=1`` to ``make`` with either |Coq|'s own makefile or a ``coq_makefile``\-made makefile, timing information is now printed for OCaml files as well (`#12211 <https://github.com/coq/coq/pull/12211>`_, by Jason Gross). @@ -701,7 +701,7 @@ Tools <https://github.com/coq/coq/pull/12034>`_, by Gaëtan Gilbert). - **Added:** A new documentation environment ``details`` to make certain portion - of a Coq document foldable. See :ref:`coqdoc-hide-show` + of a |Coq| document foldable. See :ref:`coqdoc-hide-show` (`#10592 <https://github.com/coq/coq/pull/10592>`_, by Thomas Letan). - **Added:** @@ -726,7 +726,7 @@ Tools ``--user``) to ``make`` (`#11302 <https://github.com/coq/coq/pull/11302>`_, by Jason Gross). - **Added:** - Coq's build system now supports both ``TIMING_FUZZ``, + |Coq|'s build system now supports both ``TIMING_FUZZ``, ``TIMING_SORT_BY``, and ``TIMING_REAL`` just like a ``Makefile`` made by ``coq_makefile`` (`#11302 <https://github.com/coq/coq/pull/11302>`_, by Jason Gross). @@ -742,7 +742,7 @@ Tools ``TIMING_SORT_BY_MEM=1`` (to pass ``--sort-by-mem``) to ``make`` (`#11606 <https://github.com/coq/coq/pull/11606>`_, by Jason Gross). - **Added:** - Coq's build system now supports both ``TIMING_INCLUDE_MEM`` and + |Coq|'s build system now supports both ``TIMING_INCLUDE_MEM`` and ``TIMING_SORT_BY_MEM`` just like a ``Makefile`` made by ``coq_makefile`` (`#11606 <https://github.com/coq/coq/pull/11606>`_, by Jason Gross). @@ -765,7 +765,7 @@ Tools (`#12091 <https://github.com/coq/coq/pull/12091>`_, by Hugo Herbelin). - **Fixed:** - The various timing targets for Coq's standard library now correctly + The various timing targets for |Coq|'s standard library now correctly display and label the "before" and "after" columns, rather than mixing them up (`#11302 <https://github.com/coq/coq/pull/11302>`_ fixes `#11301 <https://github.com/coq/coq/issues/11301>`_, by Jason @@ -799,15 +799,15 @@ Tools <https://github.com/coq/coq/pull/12388>`_, fixes `#12387 <https://github.com/coq/coq/pull/12387>`_, by Jason Gross). -CoqIDE -^^^^^^ +|CoqIDE| +^^^^^^^^ - **Removed:** - "Tactic" menu from CoqIDE which had been unmaintained for a number of years + "Tactic" menu from |CoqIDE| which had been unmaintained for a number of years (`#11414 <https://github.com/coq/coq/pull/11414>`_, by Pierre-Marie Pédrot). - **Removed:** - "Revert all buffers" command from CoqIDE which had been broken for a long time + "Revert all buffers" command from |CoqIDE| which had been broken for a long time (`#11415 <https://github.com/coq/coq/pull/11415>`_, by Pierre-Marie Pédrot). @@ -1038,7 +1038,7 @@ Extraction - **Added:** Support for better extraction of strings in OCaml and Haskell: - `ExtOcamlNativeString` provides bindings from the Coq `String` type to + `ExtOcamlNativeString` provides bindings from the |Coq| `String` type to the OCaml `string` type, and string literals can be extracted to literals, both in OCaml and Haskell (`#10486 <https://github.com/coq/coq/pull/10486>`_, by Xavier Leroy, with help from @@ -1063,7 +1063,7 @@ Reference manual organization. In the new version, there are fewer top-level chapters, and, in the HTML format, chapters are split into smaller pages. This is still a work in progress and further restructuring - is expected in the next versions of Coq + is expected in the next versions of |Coq| (`CEP#43 <https://github.com/coq/ceps/pull/43>`_, implemented in `#11601 <https://github.com/coq/coq/pull/11601>`_, `#11871 <https://github.com/coq/coq/pull/11871>`_, @@ -1076,7 +1076,7 @@ Reference manual help and reviews of Jim Fehrle, Clément Pit-Claudel and others). - **Changed:** Most of the grammar is now presented using the notation mechanism - that has been used to present commands and tactics since Coq 8.8 and + that has been used to present commands and tactics since |Coq| 8.8 and which is documented in :ref:`syntax-conventions` (`#11183 <https://github.com/coq/coq/pull/11183>`_, `#11314 <https://github.com/coq/coq/pull/11314>`_, @@ -1201,9 +1201,9 @@ Changes in 8.12.0 fixes `#11970 <https://github.com/coq/coq/issues/11970>`_, by Pierre-Marie Pédrot). -**CoqIDE** +**|CoqIDE|** -- **Fixed:** CoqIDE no longer exits when trying to open a file whose name is not a valid identifier +- **Fixed:** |CoqIDE| no longer exits when trying to open a file whose name is not a valid identifier (`#12562 <https://github.com/coq/coq/pull/12562>`_, fixes `#10988 <https://github.com/coq/coq/issues/10988>`_, by Vincent Laporte). @@ -1250,7 +1250,7 @@ The main changes brought by |Coq| version 8.11 are: instances of the constructive and classical real numbers. Additionally, while the :tacn:`omega` tactic is not yet deprecated in -this version of Coq, it should soon be the case and we already +this version of |Coq|, it should soon be the case and we already recommend users to switch to :tacn:`lia` in new proof scripts (see also the warning message in the :ref:`corresponding chapter <omega_chapter>`). @@ -1260,7 +1260,7 @@ of |Coq| and affected releases. See the `Changes in 8.11+beta1`_ section and following sections for the detailed list of changes, including potentially breaking changes marked with **Changed**. -Coq's documentation is available at https://coq.github.io/doc/v8.11/api (documentation of +|Coq|'s documentation is available at https://coq.github.io/doc/v8.11/api (documentation of the ML API), https://coq.github.io/doc/v8.11/refman (reference manual), and https://coq.github.io/doc/v8.11/stdlib (documentation of the standard library). @@ -1322,7 +1322,7 @@ Changes in 8.11+beta1 computation. Primitive floats are added in the language of terms, following the binary64 format of the IEEE 754 standard, and the related operations are implemented for the different reduction - engines of Coq by using the corresponding processor operators in + engines of |Coq| by using the corresponding processor operators in rounding-to-nearest-even. The properties of these operators are axiomatized in the theory :g:`Coq.Floats.FloatAxioms` which is part of the library :g:`Coq.Floats.Floats`. @@ -1415,7 +1415,7 @@ Changes in 8.11+beta1 Output of the :cmd:`Print` and :cmd:`About` commands. Arguments meta-data is now displayed as the corresponding :cmd:`Arguments` command instead of the - human-targeted prose used in previous Coq versions. (`#10985 + human-targeted prose used in previous |Coq| versions. (`#10985 <https://github.com/coq/coq/pull/10985>`_, by Gaëtan Gilbert). .. _811RefineInstance: @@ -1463,8 +1463,8 @@ Changes in 8.11+beta1 A simplification of parsing rules could cause a slight change of parsing precedences for the very rare users who defined notations with `constr` at level strictly between 100 and 200 and used these - notations on the right-hand side of a cast operator (`:`, `:>`, - `:>>`) (`#10963 <https://github.com/coq/coq/pull/10963>`_, by Théo + notations on the right-hand side of a cast operator (`:`, `<:`, + `<<:`) (`#10963 <https://github.com/coq/coq/pull/10963>`_, by Théo Zimmermann, simplification initially noticed by Jim Fehrle). **Tactics** @@ -1514,7 +1514,7 @@ Changes in 8.11+beta1 - **Added:** Ltac2, a new version of the tactic language Ltac, that doesn't - preserve backward compatibility, has been integrated in the main Coq + preserve backward compatibility, has been integrated in the main |Coq| distribution. It is still experimental, but we already recommend users of advanced Ltac to start using it and report bugs or request enhancements. See its documentation in the :ref:`dedicated chapter @@ -1543,14 +1543,14 @@ Changes in 8.11+beta1 Generalize tactics :tacn:`under` and :tacn:`over` for any registered relation. More precisely, assume the given context lemma has type `forall f1 f2, .. -> (forall i, R1 (f1 i) (f2 i)) -> R2 f1 f2`. The - first step performed by :tacn:`under` (since Coq 8.10) amounts to + first step performed by :tacn:`under` (since |Coq| 8.10) amounts to calling the tactic :tacn:`rewrite <rewrite (ssreflect)>`, which itself relies on :tacn:`setoid_rewrite` if need be. So this step was already compatible with a double implication or setoid equality for the conclusion head symbol `R2`. But a further step consists in tagging the generated subgoal `R1 (f1 i) (?f2 i)` to protect it from unwanted evar instantiation, and get `Under_rel _ R1 (f1 i) (?f2 i)` - that is displayed as ``'Under[ f1 i ]``. In Coq 8.10, this second + that is displayed as ``'Under[ f1 i ]``. In |Coq| 8.10, this second (convenience) step was only performed when `R1` was Leibniz' `eq` or `iff`. Now, it is also performed for any relation `R1` which has a ``RewriteRelation`` instance (a `RelationClasses.Reflexive` instance @@ -1612,7 +1612,7 @@ Changes in 8.11+beta1 .. warning:: This is a common source of incompatibilities in projects - migrating to Coq 8.11. + migrating to |Coq| 8.11. - **Changed:** Output generated by :flag:`Printing Dependent Evars Line` flag @@ -1643,7 +1643,7 @@ Changes in 8.11+beta1 `coqc` now provides the ability to generate compiled interfaces. Use `coqc -vos foo.v` to skip all opaque proofs during the compilation of `foo.v`, and output a file called `foo.vos`. - This feature is experimental. It enables working on a Coq file without the need to + This feature is experimental. It enables working on a |Coq| file without the need to first compile the proofs contained in its dependencies (`#8642 <https://github.com/coq/coq/pull/8642>`_ by Arthur Charguéraud, review by Maxime Dénès and Emilio Gallego). @@ -1715,7 +1715,7 @@ Changes in 8.11+beta1 **Infrastructure and dependencies** - **Changed:** - Coq now officially supports OCaml 4.08. + |Coq| now officially supports OCaml 4.08. See `INSTALL` file for details (`#10471 <https://github.com/coq/coq/pull/10471>`_, by Emilio Jesús Gallego Arias). @@ -1793,7 +1793,7 @@ Changes in 8.11.0 **Tactic language** - **Fixed:** - Syntax of tactic `cofix ... with ...` was broken since Coq 8.10 + Syntax of tactic `cofix ... with ...` was broken since |Coq| 8.10 (`#11241 <https://github.com/coq/coq/pull/11241>`_, by Hugo Herbelin). @@ -1826,9 +1826,9 @@ Changes in 8.11.0 fixes `#11353 <https://github.com/coq/coq/issues/11353>`_, by Karl Palmskog). -**CoqIDE** +**|CoqIDE|** -- **Changed:** CoqIDE now uses the GtkSourceView native implementation +- **Changed:** |CoqIDE| now uses the GtkSourceView native implementation of the autocomplete mechanism (`#11400 <https://github.com/coq/coq/pull/11400>`_, by Pierre-Marie Pédrot). @@ -1874,7 +1874,7 @@ Changes in 8.11.1 (`#11859 <https://github.com/coq/coq/pull/11859>`_, by Pierre Roux). -**CoqIDE** +**|CoqIDE|** - **Fixed:** Compiling file paths containing spaces @@ -1932,21 +1932,21 @@ Changes in 8.11.2 (`#12070 <https://github.com/coq/coq/pull/12070>`_, by Pierre Roux). -**CoqIDE** +**|CoqIDE|** - **Changed:** - CoqIDE now uses native window frames by default on Windows. + |CoqIDE| now uses native window frames by default on Windows. The GTK window frames can be restored by setting the `GTK_CSD` environment variable to `1` (`#12060 <https://github.com/coq/coq/pull/12060>`_, fixes `#11080 <https://github.com/coq/coq/issues/11080>`_, by Attila Gáspár). - **Fixed:** - New patch presumably fixing the random Coq 8.11 segfault issue with CoqIDE completion + New patch presumably fixing the random |Coq| 8.11 segfault issue with |CoqIDE| completion (`#12068 <https://github.com/coq/coq/pull/12068>`_, by Hugo Herbelin, presumably fixing `#11943 <https://github.com/coq/coq/pull/11943>`_). - **Fixed:** - Highlighting style consistently applied to all three buffers of CoqIDE + Highlighting style consistently applied to all three buffers of |CoqIDE| (`#12106 <https://github.com/coq/coq/pull/12106>`_, by Hugo Herbelin; fixes `#11506 <https://github.com/coq/coq/pull/11506>`_). @@ -2058,15 +2058,15 @@ reference manual. Here are the most important user-visible changes: :math:`\Type`. It used to be limited to sort `Prop` (`#7634 <https://github.com/coq/coq/pull/7634>`_, by Théo Winterhalter). -- A new registration mechanism for reference from ML code to Coq +- A new registration mechanism for reference from ML code to |Coq| constructs has been added (`#186 <https://github.com/coq/coq/pull/186>`_, by Emilio Jesús Gallego Arias, Maxime Dénès and Vincent Laporte). -- CoqIDE: +- |CoqIDE|: - - CoqIDE now depends on gtk+3 and lablgtk3 instead of gtk+2 and lablgtk2. - The INSTALL file available in the Coq sources has been updated to list + - |CoqIDE| now depends on gtk+3 and lablgtk3 instead of gtk+2 and lablgtk2. + The INSTALL file available in the |Coq| sources has been updated to list the new dependencies (`#9279 <https://github.com/coq/coq/pull/9279>`_, by Hugo Herbelin, with help from Jacques Garrigue, @@ -2081,15 +2081,15 @@ reference manual. Here are the most important user-visible changes: - Infrastructure and dependencies: - - Coq 8.10 requires OCaml >= 4.05.0, bumped from 4.02.3 See the + - |Coq| 8.10 requires OCaml >= 4.05.0, bumped from 4.02.3 See the `INSTALL` file for more information on dependencies (`#7522 <https://github.com/coq/coq/pull/7522>`_, by Emilio Jesús Gallego Arías). - - Coq 8.10 doesn't need Camlp5 to build anymore. It now includes a - fork of the core parsing library that Coq uses, which is a small + - |Coq| 8.10 doesn't need Camlp5 to build anymore. It now includes a + fork of the core parsing library that |Coq| uses, which is a small subset of the whole Camlp5 distribution. In particular, this subset doesn't depend on the OCaml AST, allowing easier compilation and - testing on experimental OCaml versions. Coq also ships a new parser + testing on experimental OCaml versions. |Coq| also ships a new parser `coqpp` that plugin authors must switch to (`#7902 <https://github.com/coq/coq/pull/7902>`_, `#7979 <https://github.com/coq/coq/pull/7979>`_, @@ -2098,19 +2098,19 @@ reference manual. Here are the most important user-visible changes: and `#8945 <https://github.com/coq/coq/pull/8945>`_, by Pierre-Marie Pédrot and Emilio Jesús Gallego Arias). - The Coq developers would like to thank Daniel de Rauglaudre for many + The |Coq| developers would like to thank Daniel de Rauglaudre for many years of continued support. - - Coq now supports building with Dune, in addition to the traditional + - |Coq| now supports building with Dune, in addition to the traditional Makefile which is scheduled for deprecation (`#6857 <https://github.com/coq/coq/pull/6857>`_, by Emilio Jesús Gallego Arias, with help from Rudi Grinberg). - Experimental support for building Coq projects has been integrated + Experimental support for building |Coq| projects has been integrated in Dune at the same time, providing an `improved experience <https://coq.discourse.group/t/a-guide-to-building-your-coq-libraries-and-plugins-with-dune/>`_ for plugin developers. We thank the Dune team for their work - supporting Coq. + supporting |Coq|. Version 8.10 also comes with a bunch of smaller-scale changes and improvements regarding the different components of the system, including @@ -2129,10 +2129,10 @@ contributions from Gaëtan Gilbert, Pierre-Marie Pédrot, and Maxime Dénès. Maxime Dénès, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Michael Soegtrop, Théo Zimmermann worked on maintaining and improving the continuous integration system and package building infrastructure. -Coq is now continuously tested against OCaml trunk, in addition to the +|Coq| is now continuously tested against the |OCaml| trunk, in addition to the oldest supported and latest OCaml releases. -Coq's documentation for the development branch is now deployed +|Coq|'s documentation for the development branch is now deployed continuously at https://coq.github.io/doc/master/api (documentation of the ML API), https://coq.github.io/doc/master/refman (reference manual), and https://coq.github.io/doc/master/stdlib (documentation of @@ -2191,13 +2191,13 @@ Other changes in 8.10+beta1 (*à la* ``-top``) based on the filename passed, taking into account the proper ``-R``/``-Q`` options. For example, given ``-R Foo foolib`` using ``-topfile foolib/bar.v`` will set the module name to ``Foo.Bar``. - CoqIDE now properly sets the module name for a given file based on + |CoqIDE| now properly sets the module name for a given file based on its path (`#8991 <https://github.com/coq/coq/pull/8991>`_, closes `#8989 <https://github.com/coq/coq/issues/8989>`_, by Gaëtan Gilbert). - - Experimental: Coq flags and options can now be set on the + - Experimental: |Coq| flags and options can now be set on the command-line, e.g. ``-set "Universe Polymorphism=true"`` (`#9876 <https://github.com/coq/coq/pull/9876>`_, by Gaëtan Gilbert). @@ -2295,7 +2295,7 @@ Other changes in 8.10+beta1 - Deprecated compatibility notations have actually been removed. Uses of these notations are generally easy to fix thanks - to the hint contained in the deprecation warning emitted by Coq + to the hint contained in the deprecation warning emitted by |Coq| 8.8 and 8.9. For projects that require more than a handful of such fixes, there is `a script <https://gist.github.com/JasonGross/9770653967de3679d131c59d42de6d17#file-replace-notations-py>`_ @@ -2310,7 +2310,7 @@ Other changes in 8.10+beta1 - The `quote plugin <https://coq.inria.fr/distrib/V8.9.0/refman/proof-engine/detailed-tactic-examples.html#quote>`_ was removed. If some users are interested in maintaining this plugin - externally, the Coq development team can provide assistance for + externally, the |Coq| development team can provide assistance for extracting the plugin and setting up a new repository (`#7894 <https://github.com/coq/coq/pull/7894>`_, by Maxime Dénès). @@ -2537,7 +2537,7 @@ Other changes in 8.10+beta1 - Changelog has been moved from a specific file `CHANGES.md` to the reference manual; former Credits chapter of the reference manual has been split in two parts: a History chapter which was enriched with - additional historical information about Coq versions 1 to 5, and a + additional historical information about |Coq| versions 1 to 5, and a Changes chapter which was enriched with the content formerly in `CHANGES.md` and `COMPATIBILITY` (`#9133 <https://github.com/coq/coq/pull/9133>`_, @@ -2580,15 +2580,15 @@ Many bug fixes and documentation improvements, in particular: fixes `#9336 <https://github.com/coq/coq/issues/9336>`_, by Andreas Lynge, review by Enrico Tassi) -**CoqIDE** +**|CoqIDE|** -- Fix CoqIDE instability on Windows after the update to gtk3 +- Fix |CoqIDE| instability on Windows after the update to gtk3 (`#10360 <https://github.com/coq/coq/pull/10360>`_, by Michael Soegtrop, closes `#9885 <https://github.com/coq/coq/issues/9885>`_). **Miscellaneous** -- Proof General can now display Coq-generated diffs between proof steps +- Proof General can now display |Coq|-generated diffs between proof steps in color (`#10019 <https://github.com/coq/coq/pull/10019>`_ and (in Proof General) `#421 <https://github.com/ProofGeneral/PG/pull/421>`_, @@ -2696,7 +2696,7 @@ A few bug fixes and documentation improvements, in particular: fixes `#10894 <https://github.com/coq/coq/issues/10894>`_, by Hugo Herbelin). -**CoqIDE** +**|CoqIDE|** - Fix handling of unicode input before space (`#10852 <https://github.com/coq/coq/pull/10852>`_, @@ -2736,9 +2736,9 @@ Changes in 8.10.2 (`#11090 <https://github.com/coq/coq/pull/11090>`_, fixes `#11033 <https://github.com/coq/coq/issues/11033>`_, by Hugo Herbelin). -**CoqIDE** +**|CoqIDE|** -- Fixed uneven dimensions of CoqIDE panels when window has been resized +- Fixed uneven dimensions of |CoqIDE| panels when window has been resized (`#11070 <https://github.com/coq/coq/pull/11070>`_, fixes 8.10-regression `#10956 <https://github.com/coq/coq/issues/10956>`_, by Guillaume Melquiond). @@ -2853,7 +2853,7 @@ important ones are documented in the next subsection file. On the implementation side, the ``dev/doc/changes.md`` file documents the numerous changes to the implementation and improvements of interfaces. The file provides guidelines on porting a plugin to the new -version and a plugin development tutorial kept in sync with Coq was +version and a plugin development tutorial kept in sync with |Coq| was introduced by Yves Bertot http://github.com/ybertot/plugin_tutorials. The new ``dev/doc/critical-bugs`` file documents the known critical bugs of |Coq| and affected releases. @@ -2917,7 +2917,7 @@ Notations entries" (see chapter "Syntax extensions" of the reference manual). - Deprecated compatibility notations will actually be removed in the - next version of Coq. Uses of these notations are generally easy to + next version of |Coq|. Uses of these notations are generally easy to fix thanks to the hint contained in the deprecation warnings. For projects that require more than a handful of such fixes, there is `a script @@ -3018,7 +3018,7 @@ Standard Library - 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 + impacts users running |Coq| without the init library (`-nois` or `-noinit`) and also issuing `Require Import Coq.Init.Datatypes`. Tools @@ -3028,10 +3028,10 @@ Tools `COQFLAGS` is now entirely separate from `COQLIBS`, so in custom Makefiles `$(COQFLAGS)` should be replaced by `$(COQFLAGS) $(COQLIBS)`. -- Removed the `gallina` utility (extracts specification from Coq vernacular files). +- Removed the `gallina` utility (extracts specification from |Coq| vernacular files). If you would like to maintain this tool externally, please contact us. -- Removed the Emacs modes distributed with Coq. You are advised to +- Removed the Emacs modes distributed with |Coq|. You are advised to use `Proof-General <https://proofgeneral.github.io/>`_ (and optionally `Company-Coq <https://github.com/cpitclaudel/company-coq>`_) instead. If your use case is not covered by these alternative Emacs modes, @@ -3060,15 +3060,15 @@ Vernacular Commands NoTCResolution`. - Multiple sections with the same name are allowed. -Coq binaries and process model +|Coq| binaries and process model -- Before 8.9, Coq distributed a single `coqtop` binary and a set of +- Before 8.9, |Coq| distributed a single `coqtop` binary and a set of dynamically loadable plugins that used to take over the main loop for tasks such as IDE language server or parallel proof checking. These plugins have been turned into full-fledged binaries so each different process has associated a particular binary now, in - particular `coqidetop` is the CoqIDE language server, and + particular `coqidetop` is the |CoqIDE| language server, and `coq{proof,tactic,query}worker` are in charge of task-specific and parallel proof checking. @@ -3126,7 +3126,7 @@ Changes in 8.8.1 - Some quality-of-life fixes. - Numerous improvements to the documentation. - Fix a critical bug related to primitive projections and :tacn:`native_compute`. -- Ship several additional Coq libraries with the Windows installer. +- Ship several additional |Coq| libraries with the Windows installer. Version 8.8 ----------- @@ -3232,7 +3232,7 @@ of everybody who to some extent influenced the development. The |Coq| consortium, an organization directed towards users and supporters of the system, is now running and employs Maxime Dénès. -The contacts of the Coq Consortium are Yves Bertot and Maxime Dénès. +The contacts of the |Coq| Consortium are Yves Bertot and Maxime Dénès. | Santiago de Chile, March 2018, | Matthieu Sozeau for the |Coq| development team @@ -3354,7 +3354,7 @@ Universes Tools -- Coq can now be run with the option -mangle-names to change the auto-generated +- |Coq| can now be run with the option -mangle-names to change the auto-generated name scheme. This is intended to function as a linter for developments that want to be robust to changes in auto-generated names. This feature is experimental, and may change or disappear without warning. @@ -3364,7 +3364,7 @@ Checker - The checker now accepts filenames in addition to logical paths. -CoqIDE +|CoqIDE| - Find and Replace All report the number of occurrences found; Find indicates when it wraps. @@ -3377,7 +3377,7 @@ coqdep Documentation -- The Coq FAQ, formerly located at https://coq.inria.fr/faq, has been +- The |Coq| FAQ, formerly located at https://coq.inria.fr/faq, has been moved to the GitHub wiki section of this repository; the main entry page is https://github.com/coq/coq/wiki/The-Coq-FAQ. - Documentation: a large community effort resulted in the migration @@ -3427,7 +3427,7 @@ Details of changes in 8.8.0 Tools - Asynchronous proof delegation policy was fixed. Since version 8.7 - Coq was ignoring previous runs and the `-async-proofs-delegation-threshold` + |Coq| was ignoring previous runs and the `-async-proofs-delegation-threshold` option did not have the expected behavior. Tactic language @@ -3700,7 +3700,7 @@ Vernacular Commands - Possibility to unset the printing of notations in a more fine grained fashion than `Unset Printing Notations` is provided without any user-syntax. The goal is that someone creates a plugin to experiment - such a user-syntax, to be later integrated in Coq when stabilized. + such a user-syntax, to be later integrated in |Coq| when stabilized. - `About` now tells if a reference is a coercion. - The deprecated `Save` vernacular and its form `Save Theorem id` to close proofs have been removed from the syntax. Please use `Qed`. @@ -3718,7 +3718,7 @@ Standard Library - New lemmas about iff and about orders on positive and Z. - New lemmas on powerRZ. - Strengthened statement of JMeq_eq_dep (closes bug #4912). -- The BigN, BigZ, BigZ libraries are no longer part of the Coq standard +- The BigN, BigZ, BigZ libraries are no longer part of the |Coq| standard library, they are now provided by a separate repository https://github.com/coq/bignums The split has been done just after the Int31 library. @@ -3732,12 +3732,12 @@ Standard Library Plugins -- The Ssreflect plugin is now distributed with Coq. Its documentation has +- The Ssreflect plugin is now distributed with |Coq|. Its documentation has been integrated as a chapter of the reference manual. This chapter is work in progress so feedback is welcome. - The mathematical proof language (also known as declarative mode) was removed. - A new command Extraction TestCompile has been introduced, not meant - for the general user but instead for Coq's test-suite. + for the general user but instead for |Coq|'s test-suite. - The extraction plugin is no longer loaded by default. It must be explicitly loaded with [Require Extraction], which is backwards compatible. @@ -3756,7 +3756,7 @@ Tools the extensibility of generated Makefiles, and to make _CoqProject files more palatable to IDEs. Overview: - * _CoqProject files contain only Coq specific data (i.e. the list of + * _CoqProject files contain only |Coq| specific data (i.e. the list of files, -R options, ...) * coq_makefile translates _CoqProject to Makefile.conf and copies in the desired location a standard Makefile (that reads Makefile.conf) @@ -3814,15 +3814,15 @@ Details of changes in 8.7+beta2 Tools -- In CoqIDE, the "Compile Buffer" command takes account of flags in +- In |CoqIDE|, the "Compile Buffer" command takes account of flags in _CoqProject or other project file. Improvements around some error messages. Many bug fixes including two important ones: -- Bug #5730: CoqIDE becomes unresponsive on file open. -- coq_makefile: make sure compile flags for Coq and coq_makefile are in sync +- Bug #5730: |CoqIDE| becomes unresponsive on file open. +- coq_makefile: make sure compile flags for |Coq| and coq_makefile are in sync (in particular, make sure the `-safe-string` option is used to compile plugins). Details of changes in 8.7.0 @@ -3833,7 +3833,7 @@ OCaml - Users can pass specific flags to the OCaml optimizing compiler by -using the flambda-opts configure-time option. - Beware that compiling Coq with a flambda-enabled compiler is + Beware that compiling |Coq| with a flambda-enabled compiler is experimental and may require large amounts of RAM and CPU, see INSTALL for more details. @@ -3863,7 +3863,7 @@ Version 8.6 Summary of changes ~~~~~~~~~~~~~~~~~~ -Coq version 8.6 contains the result of refinements, stabilization of +|Coq| version 8.6 contains the result of refinements, stabilization of 8.5’s features and cleanups of the internals of the system. Over the year of (now time-based) development, about 450 bugs were resolved and over 100 contributions integrated. The main user visible changes are: @@ -3897,7 +3897,7 @@ over 100 contributions integrated. The main user visible changes are: - Integration of LtacProf, a profiler for Ltac by Jason Gross, Paul Steckler, Enrico Tassi and Tobias Tebbi. -Coq 8.6 also comes with a bunch of smaller-scale changes and +|Coq| 8.6 also comes with a bunch of smaller-scale changes and improvements regarding the different components of the system. We shall only list a few of them. @@ -3983,13 +3983,13 @@ development. Version 8.6 is the first release of |Coq| developed on a time-based development cycle. Its development spanned 10 months from the release of -Coq 8.5 and was based on a public roadmap. To date, it contains more +|Coq| 8.5 and was based on a public roadmap. To date, it contains more external contributions than any previous |Coq| system. Code reviews were systematically done before integration of new features, with an important focus given to compatibility and performance issues, resulting in a hopefully more robust release than |Coq| 8.5. -Coq Enhancement Proposals (CEPs for short) were introduced by Enrico +|Coq| Enhancement Proposals (CEPs for short) were introduced by Enrico Tassi to provide more visibility and a discussion period on new features, they are publicly available https://github.com/coq/ceps. @@ -4134,13 +4134,13 @@ General infrastructure - New configurable warning system which can be controlled with the vernacular command "Set Warnings", or, under coqc/coqtop, with the flag "-w". In particular, the default is now that warnings are printed by coqc. -- In asynchronous mode, Coq is now capable of recovering from errors and +- In asynchronous mode, |Coq| is now capable of recovering from errors and continue processing the document. Tools - coqc accepts a -o option to specify the output file name -- coqtop accepts --print-version to print Coq and OCaml versions in +- coqtop accepts --print-version to print |Coq| and |OCaml| versions in easy to parse format - Setting [Printing Dependent Evars Line] can be unset to disable the computation associated with printing the "dependent evars: " line in @@ -4169,7 +4169,7 @@ Other bug fixes in universes, type class shelving,... Details of changes in 8.6.1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Fix #5380: Default colors for CoqIDE are actually applied. +- Fix #5380: Default colors for |CoqIDE| are actually applied. - Fix plugin warnings - Document named evars (including Show ident) - Fix Bug #5574, document function scope @@ -4221,7 +4221,7 @@ Version 8.5 Summary of changes ~~~~~~~~~~~~~~~~~~ -Coq version 8.5 contains the result of five specific long-term projects: +|Coq| version 8.5 contains the result of five specific long-term projects: - A new asynchronous evaluation and compilation mode by Enrico Tassi with help from Bruno Barras and Carst Tankink. @@ -4312,7 +4312,7 @@ conversion test and normal form computation using the OCaml native compiler. It complements the virtual machine conversion offering much faster computation for expensive functions. -Coq 8.5 also comes with a bunch of many various smaller-scale changes +|Coq| 8.5 also comes with a bunch of many various smaller-scale changes and improvements regarding the different components of the system. We shall only list a few of them. @@ -4375,8 +4375,8 @@ Tankink. Maxime Dénès coordinated the release process. Potential sources of incompatibilities ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -List of typical changes to be done to adapt files from Coq 8.4 -to Coq 8.5 when not using compatibility option ``-compat 8.4``. +List of typical changes to be done to adapt files from |Coq| 8.4 +to |Coq| 8.5 when not using compatibility option ``-compat 8.4``. - Symptom: "The reference omega was not found in the current environment". @@ -4511,7 +4511,7 @@ Logic logic inconsistent). - The guard condition for fixpoints is now a bit stricter. Propagation of subterm value through pattern matching is restricted according to - the return predicate. Restores compatibility of Coq's logic with the + the return predicate. Restores compatibility of |Coq|'s logic with the propositional extensionality axiom. May create incompatibilities in recursive programs heavily using dependent types. - Trivial inductive types are no longer defined in Type but in Prop, which @@ -4551,7 +4551,7 @@ Vernacular commands - A new Print Strategies command allows visualizing the opacity status of the whole engine. - The "Locate" command now searches through all sorts of qualified namespaces of - Coq: terms, modules, tactics, etc. The old behavior of the command can be + |Coq|: terms, modules, tactics, etc. The old behavior of the command can be retrieved using the "Locate Term" command. - New "Derive" command to help writing program by derivation. - New "Refine Instance Mode" option that allows to deactivate the generation of @@ -4879,24 +4879,24 @@ Tools files from the quickly generated proofs. - The XML plugin was discontinued and removed from the source. - A new utility called coqworkmgr can be used to limit the number of - concurrent workers started by independent processes, like make and CoqIDE. + concurrent workers started by independent processes, like make and |CoqIDE|. This is of interest for users of the par: goal selector. Interfaces -- CoqIDE supports asynchronous edition of the document, ongoing tasks and +- |CoqIDE| supports asynchronous edition of the document, ongoing tasks and errors are reported in the bottom right window. The number of workers taking care of processing proofs can be selected with -async-proofs-j. -- CoqIDE highlights in yellow "unsafe" commands such as axiom +- |CoqIDE| highlights in yellow "unsafe" commands such as axiom declarations, and tactics like "give_up". -- CoqIDE supports Proof General like key bindings; +- |CoqIDE| supports Proof General like key bindings; to activate the PG mode go to Edit -> Preferences -> Editor. For the documentation see Help -> Help for PG mode. -- CoqIDE automatically retracts the locked area when one edits the +- |CoqIDE| automatically retracts the locked area when one edits the locked text. -- CoqIDE search and replace got regular expressions power. See the +- |CoqIDE| search and replace got regular expressions power. See the documentation of OCaml's Str module for the supported syntax. -- Many CoqIDE windows, including the query one, are now detachable to +- Many |CoqIDE| windows, including the query one, are now detachable to improve usability on multi screen work stations. - Coqtop/coqc outputs highlighted syntax. Colors can be configured thanks to the COQ_COLORS environment variable, and their current state can @@ -4907,7 +4907,7 @@ Interfaces Internal Infrastructure - Many reorganizations in the ocaml source files. For instance, - many internal a.s.t. of Coq are now placed in mli files in + many internal a.s.t. of |Coq| are now placed in mli files in a new directory intf/, for instance constrexpr.mli or glob_term.mli. More details in dev/doc/changes. @@ -4959,7 +4959,7 @@ Tactics Extraction - Definitions extracted to Haskell GHC should no longer randomly - segfault when some Coq types cannot be represented by Haskell types. + segfault when some |Coq| types cannot be represented by Haskell types. - Definitions can now be extracted to Json for post-processing. Tools @@ -5057,8 +5057,8 @@ Tools Standard Library - There is now a Coq.Compat.Coq84 library, which sets the various compatibility - options and does a few redefinitions to make Coq behave more like Coq v8.4. - The standard way of putting Coq in v8.4 compatibility mode is to pass the command + options and does a few redefinitions to make |Coq| behave more like |Coq| v8.4. + The standard way of putting |Coq| in v8.4 compatibility mode is to pass the command line flags "-require Coq.Compat.Coq84 -compat 8.4". Details of changes in 8.5 @@ -5067,7 +5067,7 @@ Details of changes in 8.5 Tools - Flag "-compat 8.4" now loads Coq.Compat.Coq84. The standard way of - putting Coq in v8.4 compatibility mode is to pass the command line flag + putting |Coq| in v8.4 compatibility mode is to pass the command line flag "-compat 8.4". It can be followed by "-require Coq.Compat.AdmitAxiom" if the 8.4 behavior of admit is needed, in which case it uses an axiom. @@ -5108,7 +5108,7 @@ Various performance improvements (time, space used by .vo files) Other bugfixes - Fix order of arguments to Big.compare_case in ExtrOcamlZBigInt.v -- Added compatibility coercions from Specif.v which were present in Coq 8.4. +- Added compatibility coercions from Specif.v which were present in |Coq| 8.4. - Fixing a source of inefficiency and an artificial dependency in the printer in the congruence tactic. - Allow to unset the refinement mode of Instance in ML - Fixing an incorrect use of prod_appvect on a term which was not a product in setoid_rewrite. @@ -5123,7 +5123,7 @@ Other bugfixes - #4623: set tactic too weak with universes (regression) - Fix incorrect behavior of CS resolution - #4591: Uncaught exception in directory browsing. -- CoqIDE is more resilient to initialization errors. +- |CoqIDE| is more resilient to initialization errors. - #4614: "Fully check the document" is uninterruptible. - Try eta-expansion of records only on non-recursive ones - Fix bug when a sort is ascribed to a Record @@ -5133,23 +5133,23 @@ Other bugfixes - Fix strategy of Keyed Unification - #4608: Anomaly "output_value: abstract value (outside heap)". - #4607: do not read native code files if native compiler was disabled. -- #4105: poor escaping in the protocol between CoqIDE and coqtop. +- #4105: poor escaping in the protocol between |CoqIDE| and coqtop. - #4596: [rewrite] broke in the past few weeks. - #4533 (partial): respect declared global transparency of projections in unification.ml - #4544: Backtrack on using full betaiota reduction during keyed unification. -- #4540: CoqIDE bottom progress bar does not update. +- #4540: |CoqIDE| bottom progress bar does not update. - Fix regression from 8.4 in reflexivity - #4580: [Set Refine Instance Mode] also used for Program Instance. - #4582: cannot override notation [ x ]. MAY CREATE INCOMPATIBILITIES, see #4683. - STM: Print/Extraction have to be skipped if -quick -- #4542: CoqIDE: STOP button also stops workers +- #4542: |CoqIDE|: STOP button also stops workers - STM: classify some variants of Instance as regular `` `Fork `` nodes. - #4574: Anomaly: Uncaught exception Invalid_argument("splay_arity"). - Do not give a name to anonymous evars anymore. See bug #4547. - STM: always stock in vio files the first node (state) of a proof - STM: not delegate proofs that contain Vernac(Module|Require|Import), #4530 - Don't fail fatally if PATH is not set. -- #4537: Coq 8.5 is slower in typeclass resolution. +- #4537: |Coq| 8.5 is slower in typeclass resolution. - #4522: Incorrect "Warning..." on windows. - #4373: coqdep does not know about .vio files. - #3826: "Incompatible module types" is uninformative. @@ -5158,7 +5158,7 @@ Other bugfixes - #4503: mixing universe polymorphic and monomorphic variables and definitions in sections is unsupported. - #4519: oops, global shadowed local universe level bindings. - #4506: Anomaly: File "pretyping/indrec.ml", line 169, characters 14-20: Assertion failed. -- #4548: Coqide crashes when going back one command +- #4548: |CoqIDE| crashes when going back one command Details of changes in 8.5pl2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -5179,8 +5179,8 @@ Other bugfixes - #4644: a regression in unification. - #4725: Function (Error: Conversion test raised an anomaly) and Program (Error: Cannot infer this placeholder of type) -- #4747: Problem building Coq 8.5pl1 with OCaml 4.03.0: Fatal warnings -- #4752: CoqIDE crash on files not ended by ".v". +- #4747: Problem building |Coq| 8.5pl1 with OCaml 4.03.0: Fatal warnings +- #4752: |CoqIDE| crash on files not ended by ".v". - #4777: printing inefficiency with implicit arguments - #4818: "Admitted" fails due to undefined universe anomaly after calling "destruct" @@ -5194,7 +5194,7 @@ Other bugfixes - #4881: synchronizing "Declare Implicit Tactic" with backtrack. - #4882: anomaly with Declare Implicit Tactic on hole of type with evars - Fix use of "Declare Implicit Tactic" in refine. - triggered by CoqIDE + triggered by |CoqIDE| - #4069, #4718: congruence fails when universes are involved. Universes @@ -5257,7 +5257,7 @@ Other bugfixes - #5097: status of evars refined by "clear" in ltac: closed wrt evars. - #5150: Missing dependency of the test-suite subsystems in prerequisite. - Fix a bug in error printing of unif constraints -- #3941: Do not stop propagation of signals when Coq is busy. +- #3941: Do not stop propagation of signals when |Coq| is busy. - #4822: Incorrect assertion in cbn. - #3479 parsing of "{" and "}" when a keyword starts with "{" or "}". - #5127: Memory corruption with the VM. @@ -5271,7 +5271,7 @@ Version 8.4 Summary of changes ~~~~~~~~~~~~~~~~~~ -Coq version 8.4 contains the result of three long-term projects: a new +|Coq| version 8.4 contains the result of three long-term projects: a new modular library of arithmetic by Pierre Letouzey, a new proof engine by Arnaud Spiwack and a new communication protocol for |CoqIDE| by Vincent Gross. @@ -5304,7 +5304,7 @@ sessions in parallel. Relying on the infrastructure work made by Vincent Gross, Pierre Letouzey, Pierre Boutillier and Pierre-Marie Pédrot contributed many various refinements of |CoqIDE|. -Coq 8.4 also comes with a bunch of various smaller-scale changes +|Coq| 8.4 also comes with a bunch of various smaller-scale changes and improvements regarding the different components of the system. The underlying logic has been extended with :math:`\eta`-conversion @@ -5382,14 +5382,14 @@ Julien Forest maintained the Function command. Matthieu Sozeau maintained the setoid rewriting mechanism. -Coq related tools have been upgraded too. In particular, coq\_makefile +|Coq| related tools have been upgraded too. In particular, coq\_makefile has been largely revised by Pierre Boutillier. Also, patches from Adam Chlipala for coqdoc have been integrated by Pierre Boutillier. Bruno Barras and Pierre Letouzey maintained the `coqchk` checker. Pierre Courtieu and Arnaud Spiwack contributed new features for using -Coq through Proof General. +|Coq| through Proof General. The Dp plugin has been removed. Use the plugin provided with Why 3 instead (http://why3.lri.fr/). @@ -5641,7 +5641,7 @@ Libraries * "<?" "<=?" "=?" for boolean tests such as Z.ltb Z.leb Z.eqb. * "÷" for the alternative integer division Z.quot implementing the Truncate - convention (former ZOdiv), while the notation for the Coq usual division + convention (former ZOdiv), while the notation for the |Coq| usual division Z.div implementing the Flooring convention remains "/". Their corresponding modulo functions are Z.rem (no notations) for Z.quot and Z.modulo (infix "mod" notation) for Z.div. @@ -5701,31 +5701,31 @@ Extraction universe polymorphism it cannot handle yet (the pair (I,I) being Prop). - Support of anonymous fields in record (#2555). -CoqIDE +|CoqIDE| -- Coqide now runs coqtop as separated process, making it more robust: +- |CoqIDE| now runs coqtop as separated process, making it more robust: coqtop subprocess can be interrupted, or even killed and relaunched (cf button "Restart Coq", ex-"Go to Start"). For allowing such interrupts, the Windows version of coqide now requires Windows >= XP SP1. -- The communication between CoqIDE and Coqtop is now done via a dialect +- The communication between |CoqIDE| and coqtop is now done via a dialect of XML (DOC TODO). -- The backtrack engine of CoqIDE has been reworked, it now uses the +- The backtrack engine of |CoqIDE| has been reworked, it now uses the "Backtrack" command similarly to Proof General. -- The Coqide parsing of sentences has be reworked and now supports +- The |CoqIDE| parsing of sentences has be reworked and now supports tactic delimitation via { }. -- Coqide now accepts the Abort command (wish #2357). -- Coqide can read coq_makefile files as "project file" and use it to +- |CoqIDE| now accepts the Abort command (wish #2357). +- |CoqIDE| can read coq_makefile files as "project file" and use it to set automatically options to send to coqtop. - Preference files have moved to $XDG_CONFIG_HOME/coq and accelerators are not stored as a list anymore. Tools -- Coq now searches directories specified in COQPATH, $XDG_DATA_HOME/coq, +- |Coq| now searches directories specified in COQPATH, $XDG_DATA_HOME/coq, $XDG_DATA_DIRS/coq, and user-contribs before the standard library. -- Coq rc file has moved to $XDG_CONFIG_HOME/coq. +- |Coq| rc file has moved to $XDG_CONFIG_HOME/coq. - Major changes to coq_makefile: @@ -5783,9 +5783,9 @@ Module System namespace from ordinary definitions: "Definition E:=0. Module E. End E." is now accepted. -CoqIDE +|CoqIDE| -- Coqide now supports the "Restart" command, and "Undo" (with a warning). +- |CoqIDE| now supports the "Restart" command, and "Undo" (with a warning). Better support for "Abort". Details of changes in 8.4 @@ -5802,9 +5802,9 @@ Vernacular commands Notations - Most compatibility notations of the standard library are now tagged as - (compat xyz), where xyz is a former Coq version, for instance "8.3". + (compat xyz), where xyz is a former |Coq| version, for instance "8.3". These notations behave as (only parsing) notations, except that they may - triggers warnings (or errors) when used while Coq is not in a corresponding + triggers warnings (or errors) when used while |Coq| is not in a corresponding -compat mode. - To activate these compatibility warnings, use "Set Verbose Compat Notations" or the command-line flag -verbose-compat-notations. @@ -5834,7 +5834,7 @@ Version 8.3 Summary of changes ~~~~~~~~~~~~~~~~~~ -Coq version 8.3 is before all a transition version with refinements or +|Coq| version 8.3 is before all a transition version with refinements or extensions of the existing features and libraries and a new tactic nsatz based on Hilbert’s Nullstellensatz for deciding systems of equations over rings. @@ -5873,7 +5873,7 @@ been done by Matthieu Sozeau, Hugo Herbelin and Pierre Letouzey. 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 +|Coq| checker, Julien Forest maintained the Function mechanism for reasoning over recursively defined functions. Matthieu Sozeau, Hugo Herbelin and Jean-Marc Notin maintained coqdoc. Frédéric Besson maintained the Micromega platform for deciding systems of inequalities. @@ -6037,12 +6037,12 @@ Module system "Inline" annotation in the type of its argument(s) (for examples of use of the new features, see libraries Structures and Numbers). - Coercions are now active only when modules are imported (use "Set Automatic - Coercions Import" to get the behavior of the previous versions of Coq). + Coercions Import" to get the behavior of the previous versions of |Coq|). Extraction - When using (Recursive) Extraction Library, the filenames are directly the - Coq ones with new appropriate extensions : we do not force anymore + |Coq| ones with new appropriate extensions : we do not force anymore uncapital first letters for Ocaml and capital ones for Haskell. - The extraction now tries harder to avoid code transformations that can be dangerous for the complexity. In particular many eta-expansions at the top @@ -6125,7 +6125,7 @@ Vernacular commands Library -- Use "standard" Coq names for the properties of eq and identity +- Use "standard" |Coq| names for the properties of eq and identity (e.g. refl_equal is now eq_refl). Support for compatibility is provided. - The function Compare_dec.nat_compare is now defined directly, @@ -6176,7 +6176,7 @@ Library - MSets library: an important evolution of the FSets library. "MSets" stands for Modular (Finite) Sets, by contrast with a forthcoming library of Class (Finite) Sets contributed by S. Lescuyer which will be - integrated with the next release of Coq. The main features of MSets are: + integrated with the next release of |Coq|. The main features of MSets are: + The use of Equivalence, Proper and other Type Classes features easing the handling of setoid equalities. @@ -6191,7 +6191,7 @@ Library Note: No Maps yet in MSets. The FSets library is still provided for compatibility, but will probably be considered as deprecated in the - next release of Coq. + next release of |Coq|. - Numbers library: @@ -6207,12 +6207,12 @@ Library Tools -- Option -R now supports binding Coq root read-only. +- Option -R now supports binding |Coq| root read-only. - New coqtop/coqc option -beautify to reformat .v files (usable e.g. to globally update notations). - New tool beautify-archive to beautify a full archive of developments. - New coqtop/coqc option -compat X.Y to simulate the general behavior - of previous versions of Coq (provides e.g. support for 8.2 compatibility). + of previous versions of |Coq| (provides e.g. support for 8.2 compatibility). Coqdoc @@ -6228,7 +6228,7 @@ Coqdoc - New option "--parse-comments" to allow parsing of regular ``(* *)`` comments. - New option "--plain-comments" to disable interpretation inside comments. -- New option "--interpolate" to try and typeset identifiers in Coq escapings +- New option "--interpolate" to try and typeset identifiers in |Coq| escapings using the available globalization information. - New option "--external url root" to refer to external libraries. - Links to section variables and notations now supported. @@ -6242,7 +6242,7 @@ Internal infrastructure - An experimental build mechanism via ocamlbuild is provided. From the top of the archive, run ./configure as usual, and then ./build. Feedback about this build mechanism is most welcome. - Compiling Coq on platforms such as Windows might be simpler + Compiling |Coq| on platforms such as Windows might be simpler this way, but this remains to be tested. - The Makefile system has been simplified and factorized with the ocamlbuild system. In particular "make" takes advantage @@ -6255,7 +6255,7 @@ Version 8.2 Summary of changes ~~~~~~~~~~~~~~~~~~ -Coq version 8.2 adds new features, new libraries and improves on many +|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 @@ -6410,7 +6410,7 @@ Vernacular commands qualified names (this holds also for coqtop/coqc option -R). - SearchAbout supports negated search criteria, reference to logical objects by their notation, and more generally search of subterms. -- "Declare ML Module" now allows to import .cmxs files when Coq is +- "Declare ML Module" now allows to import .cmxs files when |Coq| is compiled in native code with a version of OCaml that supports native Dynlink (>= 3.11). - Specific sort constraints on Record now taken into account. @@ -6451,7 +6451,7 @@ Libraries version should be fairly good, but some adaptations may be required. * Interfaces of unordered ("weak") and ordered sets have been factorized - thanks to new features of Coq modules (in particular Include), see + thanks to new features of |Coq| modules (in particular Include), see FSetInterface. Same for maps. Hints in these interfaces have been reworked (they are now placed in a "set" database). * To allow full subtyping between weak and ordered sets, a field @@ -6482,7 +6482,7 @@ Libraries initial Ocaml code and written via the Function framework. - Library IntMap, subsumed by FSets/FMaps, has been removed from - Coq Standard Library and moved into a user contribution Cachan/IntMap + |Coq| Standard Library and moved into a user contribution Cachan/IntMap - Better computational behavior of some constants (eq_nat_dec and le_lt_dec more efficient, Z_lt_le_dec and Positive_as_OT.compare @@ -6687,7 +6687,7 @@ Tactics - New tactic "specialize H with a" or "specialize (H a)" allows to transform in-place a universally-quantified hypothesis (H : forall x, T x) into its instantiated form (H : T a). Nota: "specialize" was in fact there in earlier - versions of Coq, but was undocumented, and had a slightly different behavior. + versions of |Coq|, but was undocumented, and had a slightly different behavior. - New tactic "contradict H" can be used to solve any kind of goal as long as the user can provide afterwards a proof of the negation of the hypothesis H. @@ -6731,7 +6731,7 @@ Program - Program Lemma, Axiom etc... now permit to have obligations in the statement iff they can be automatically solved by the default tactic. - Renamed "Obligations Tactic" command to "Obligation Tactic". -- New command "Preterm [ of id ]" to see the actual term fed to Coq for +- New command "Preterm [ of id ]" to see the actual term fed to |Coq| for debugging purposes. - New option "Transparent Obligations" to control the declaration of obligations as transparent or opaque. All obligations are now transparent @@ -6823,7 +6823,7 @@ Extraction not happen anymore. - The command Extract Inductive has now a syntax for infix notations. This - allows in particular to map Coq lists and pairs onto Caml ones: + allows in particular to map |Coq| lists and pairs onto |OCaml| ones: + Extract Inductive list => list [ "[]" "(::)" ]. + Extract Inductive prod => "(*)" [ "(,)" ]. @@ -6837,16 +6837,16 @@ Extraction conflits with existing code, for instance when extracting module List to Ocaml. -CoqIDE +|CoqIDE| -- CoqIDE font defaults to monospace so as indentation to be meaningful. -- CoqIDE supports nested goals and any other kind of declaration in the middle +- |CoqIDE| font defaults to monospace so as indentation to be meaningful. +- |CoqIDE| supports nested goals and any other kind of declaration in the middle of a proof. -- Undoing non-tactic commands in CoqIDE works faster. -- New CoqIDE menu for activating display of various implicit informations. +- Undoing non-tactic commands in |CoqIDE| works faster. +- New |CoqIDE| menu for activating display of various implicit informations. - Added the possibility to choose the location of tabs in coqide: (in Edit->Preferences->Misc) -- New Open and Save As dialogs in CoqIDE which filter ``*.v`` files. +- New Open and Save As dialogs in |CoqIDE| which filter ``*.v`` files. Tools @@ -6855,22 +6855,22 @@ Tools - New coqtop/coqc option -exclude-dir to exclude subdirs for option -R. - The binary "parser" has been renamed to "coq-parser". - Improved coqdoc and dump of globalization information to give more - meta-information on identifiers. All categories of Coq definitions are + meta-information on identifiers. All categories of |Coq| definitions are supported, which makes typesetting trivial in the generated documentation. Support for hyperlinking and indexing developments in the tex output has been implemented as well. Miscellaneous -- Coq installation provides enough files so that Ocaml's extensions need not - the Coq sources to be compiled (this assumes O'Caml 3.10 and Camlp5). +- |Coq| installation provides enough files so that Ocaml's extensions need not + the |Coq| sources to be compiled (this assumes O'Caml 3.10 and Camlp5). - New commands "Set Whelp Server" and "Set Whelp Getter" to customize the Whelp search tool. - Syntax of "Test Printing Let ref" and "Test Printing If ref" changed into "Test Printing Let for ref" and "Test Printing If for ref". - An overhauled build system (new Makefiles); see dev/doc/build-system.txt. - Add -browser option to configure script. -- Build a shared library for the C part of Coq, and use it by default on +- Build a shared library for the C part of |Coq|, and use it by default on non-(Windows or MacOS) systems. Bytecode executables are now pure. The behaviour is configurable with -coqrunbyteflags, -coqtoolsbyteflags and -custom configure options. @@ -6883,7 +6883,7 @@ Version 8.1 Summary of changes ~~~~~~~~~~~~~~~~~~ -Coq version 8.1 adds various new functionalities. +|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 @@ -6991,7 +6991,7 @@ Vernacular commands Ltac and tactic syntactic extensions -- New primitive "external" for communication with tool external to Coq +- New primitive "external" for communication with tool external to |Coq| - New semantics for "match t with": if a clause returns a tactic, it is now applied to the current goal. If it fails, the next clause or next matching subterm is tried (i.e. it behaves as "match @@ -7016,7 +7016,7 @@ Tactics - New conversion tactic "vm_compute": evaluates the goal (or an hypothesis) with a call-by-value strategy, using the compiled version of terms. -- When rewriting H where H is not directly a Coq equality, search first H for +- When rewriting H where H is not directly a |Coq| equality, search first H for a registered setoid equality before starting to reduce in H. This is unlikely to break any script. Should this happen nonetheless, one can insert manually some "unfold ... in H" before rewriting. @@ -7061,7 +7061,7 @@ Tactics - New tactic "pose proof" that generalizes "assert (id:=p)" with intro patterns. -- New introduction pattern "?" for letting Coq choose a name. +- New introduction pattern "?" for letting |Coq| choose a name. - Introduction patterns now support side hypotheses (e.g. intros [|] on "(nat -> nat) -> nat" works). @@ -7147,7 +7147,7 @@ Libraries Zlt_square_simpl removed; fixed names mentioning letter O instead of digit 0; weaken premises in Z_lt_induction). - Restructuration of Eqdep_dec.v and Eqdep.v: more lemmas in Type. -- Znumtheory now contains a gcd function that can compute within Coq. +- Znumtheory now contains a gcd function that can compute within |Coq|. - More lemmas stated on Type in Wf.v, removal of redundant Acc_iter and Acc_iter2. - Change of the internal names of lemmas in OmegaLemmas. @@ -7180,7 +7180,7 @@ Tools - Tool coq_makefile now removes custom targets that are file names in "make clean" - New environment variable COQREMOTEBROWSER to set the command invoked - to start the remote browser both in Coq and coqide. Standard syntax: + to start the remote browser both in |Coq| and |CoqIDE|. Standard syntax: "%s" is the placeholder for the URL. Details of changes in 8.1gamma @@ -7256,7 +7256,7 @@ Version 8.0 Summary of changes ~~~~~~~~~~~~~~~~~~ -Coq version 8 is a major revision of the |Coq| proof assistant. First, the +|Coq| version 8 is a major revision of the |Coq| proof assistant. First, the underlying logic is slightly different. The so-called *impredicativity* of the sort Set has been dropped. The main reason is that it is inconsistent with the principle of description which is quite a useful @@ -7294,7 +7294,7 @@ purpose here is a better uniformity making the tactics and commands easier to use and to remember. Thirdly, a restructuring and uniformization of the standard library of -Coq has been performed. There is now just one Leibniz equality usable +|Coq| has been performed. There is now just one Leibniz equality usable for all the different kinds of |Coq| objects. Also, the set of real numbers now lies at the same level as the sets of natural and integer numbers. Finally, the names of the standard properties of numbers now @@ -7511,19 +7511,19 @@ Miscellaneous Incompatibilities -- Persistence of true_sub (4 incompatibilities in Coq user contributions) +- Persistence of true_sub (4 incompatibilities in |Coq| user contributions) - Variable names of some constants changed for a better uniformity (2 changes - in Coq user contributions) + in |Coq| user contributions) - Naming of quantified names in goal now avoid global names (2 occurrences) - NewInduction naming for inductive types with functional arguments - (no incompatibility in Coq user contributions) + (no incompatibility in |Coq| user contributions) - Contradiction now solve more goals (source of 2 incompatibilities) - Merge of eq and eqT may exceptionally result in subgoals now solved automatically - Redundant pairs of ZArith lemmas may have different names: it may cause "Apply/Rewrite with" to fail if using the first name of a pair of redundant lemmas (this is solved by renaming the variables bound by - "with"; 3 incompatibilities in Coq user contribs) + "with"; 3 incompatibilities in |Coq| user contribs) - ML programs referring to constants from fast_integer.v must use "Coqlib.gen_constant_modules Coqlib.zarith_base_modules" instead @@ -7559,7 +7559,7 @@ Revision of the standard library "Zmult_le_compat_r", "SUPERIEUR" -> "Gt", "ZERO" -> "Z0") - Order and names of arguments of basic lemmas on nat, Z, positive and R have been made uniform. -- Notions of Coq initial state are declared with (strict) implicit arguments +- Notions of |Coq| initial state are declared with (strict) implicit arguments - eq merged with eqT: old eq disappear, new eq (written =) is old eqT and new eqT is syntactic sugar for new eq (notation == is an alias for = and is written as it, exceptional source of incompatibilities) @@ -7590,7 +7590,7 @@ Known problems of the automatic translation - iso-latin-1 characters are no longer supported: move your files to 7-bits ASCII or unicode before translation (switch to unicode is automatically done if a file is loaded and saved again by coqide) -- Renaming in ZArith: incompatibilities in Coq user contribs due to +- Renaming in ZArith: incompatibilities in |Coq| user contribs due to merging names INZ, from Reals, and inject_nat. - Renaming and new lemmas in ZArith: may clash with names used by users - Restructuration of ZArith: replace requirement of specific modules @@ -7640,7 +7640,7 @@ Tactics and the tactic Language Executables and tools - Added option -top to change the name of the toplevel module "Top" -- Coqdoc updated to new syntax and now part of Coq sources +- Coqdoc updated to new syntax and now part of |Coq| sources - XML exportation tool now exports the structure of vernacular files (cf chapter 13 in the reference manual) diff --git a/doc/sphinx/conf.py b/doc/sphinx/conf.py index a8a574c861..75ac2a76cd 100755 --- a/doc/sphinx/conf.py +++ b/doc/sphinx/conf.py @@ -183,9 +183,7 @@ todo_include_todos = False nitpicky = True nitpick_ignore = [ ('token', token) for token in [ - 'collection', 'tactic', - 'bindings', 'induction_clause', 'conversion', 'where', diff --git a/doc/sphinx/history.rst b/doc/sphinx/history.rst index 02821613cc..bab9bfcadb 100644 --- a/doc/sphinx/history.rst +++ b/doc/sphinx/history.rst @@ -1,16 +1,16 @@ .. _history: --------------------- -Early history of Coq --------------------- +---------------------- +Early history of |Coq| +---------------------- Historical roots ---------------- -Coq is a proof assistant for higher-order logic, allowing the +|Coq| is a proof assistant for higher-order logic, allowing the development of computer programs consistent with their formal specification. It is the result of about ten years [#years]_ of research -of the Coq project. We shall briefly survey here three main aspects: the +of the |Coq| project. We shall briefly survey here three main aspects: the *logical language* in which we write our axiomatizations and specifications, the *proof assistant* which allows the development of verified mathematical proofs, and the *program extractor* which @@ -153,7 +153,7 @@ by A. Felty. It allowed operation of the theorem-prover through the manipulation of windows, menus, mouse-sensitive buttons, and other widgets. This system (Version 5.6) was released in 1991. -Coq was ported to the new implementation Caml-light of X. Leroy and D. +|Coq| was ported to the new implementation Caml-light of X. Leroy and D. Doligez by D. de Rauglaudre (Version 5.7) in 1992. A new version of |Coq| was then coordinated by C. Murthy, with new tools designed by C. Parent to prove properties of ML programs (this methodology is dual to program @@ -477,7 +477,7 @@ C. Paulin-Mohring. *Inductively defined types* :cite:`CP90`. This led to the Calculus of Inductive Constructions, logical formalism implemented in Versions 5 upward of the system, and documented in: -C. Paulin-Mohring. *Inductive Definitions in the System Coq - Rules +C. Paulin-Mohring. *Inductive Definitions in the System |Coq| - Rules and Properties* :cite:`P93`. The last version of CONSTR is Version 4.11, which was last distributed @@ -489,7 +489,7 @@ Version 5 ~~~~~~~~~ At the end of 1989, Version 5.1 was started, and renamed as the system -Coq for the Calculus of Inductive Constructions. It was then ported to +|Coq| for the Calculus of Inductive Constructions. It was then ported to the new stand-alone implementation of ML called Caml-light. In 1990 many changes occurred. Thierry Coquand left for Chalmers @@ -497,7 +497,7 @@ University in Göteborg. Christine Paulin-Mohring took a CNRS researcher position at the LIP laboratory of École Normale Supérieure de Lyon. Project Formel was terminated, and gave rise to two teams: Cristal at INRIA-Roquencourt, that continued developments in -functional programming with Caml-light then OCaml, and Coq, continuing +functional programming with Caml-light then OCaml, and |Coq|, continuing the type theory research, with a joint team headed by Gérard Huet at INRIA-Rocquencourt and Christine Paulin-Mohring at the LIP laboratory of CNRS-ENS Lyon. @@ -736,7 +736,7 @@ Notes: Main novelties ^^^^^^^^^^^^^^ -References are to Coq 7.1 reference manual +References are to |Coq| 7.1 reference manual - New primitive let-in construct (see sections 1.2.8 and ) - Long names (see sections 2.6 and 2.7) @@ -770,7 +770,7 @@ Language: long names name, the name of the module in which they are defined (Top if in coqtop), and possibly an arbitrary long sequence of directory (e.g. "Coq.Lists.PolyList.flat_map" where "Coq" means that "flat_map" is part - of Coq standard library, "Lists" means it is defined in the Lists + of |Coq| standard library, "Lists" means it is defined in the Lists library and "PolyList" means it is in the file Polylist) (+) - Constructions can be referred by their base name, or, in case of @@ -829,7 +829,7 @@ Reduction - Constants declared as opaque (using Qed) can no longer become transparent (a constant intended to be alternatively opaque and transparent must be declared as transparent (using Defined)); a risk - exists (until next Coq version) that Simpl and Hnf reduces opaque + exists (until next |Coq| version) that Simpl and Hnf reduces opaque constants (*) @@ -1171,7 +1171,7 @@ Incompatibilities - New naming strategy for NewInduction/NewDestruct may affect 7.1 compatibility - Extra parentheses may exceptionally be needed in tactic definitions. -- Coq extensions written in Ocaml need to be updated (see dev/changements.txt +- |Coq| extensions written in |OCaml| need to be updated (see dev/changements.txt for a description of the main changes in the interface files of V7.2) - New behaviour of Intuition/Tauto may exceptionally lead to incompatibilities @@ -1205,7 +1205,7 @@ Tactics product if needed (source of incompatibilities) - "Match Context" now matching more recent hypotheses first and failing only on user errors and Fail tactic (possible source of incompatibilities) -- Tactic Definition's without arguments now allowed in Coq states +- Tactic Definition's without arguments now allowed in |Coq| states - Better simplification and discrimination made by Inversion (source of incompatibilities) @@ -1239,7 +1239,7 @@ User Contributions - CongruenceClosure (congruence closure decision procedure) [Pierre Corbineau, ENS Cachan] - MapleMode (an interface to embed Maple simplification procedures over - rational fractions in Coq) + rational fractions in |Coq|) [David Delahaye, Micaela Mayero, Chalmers University] - Presburger: A formalization of Presburger's algorithm [Laurent Thery, INRIA Sophia Antipolis] @@ -1283,7 +1283,7 @@ Bug fixes Misc - - Ocaml version >= 3.06 is needed to compile Coq from sources + - Ocaml version >= 3.06 is needed to compile |Coq| from sources - Simplification of fresh names creation strategy for Assert, Pose and LetTac (#1402) @@ -1398,7 +1398,7 @@ Extraction (See details in plugins/extraction/CHANGES and README): - An experimental Scheme extraction is provided. - Concerning OCaml, extracted code is now ensured to always type check, thanks to automatic inserting of Obj.magic. -- Experimental extraction of Coq new modules to Ocaml modules. +- Experimental extraction of |Coq| new modules to Ocaml modules. Proof rendering in natural language diff --git a/doc/sphinx/introduction.rst b/doc/sphinx/introduction.rst index b059fb4069..dc16897d42 100644 --- a/doc/sphinx/introduction.rst +++ b/doc/sphinx/introduction.rst @@ -1,8 +1,8 @@ -This is the reference manual of |Coq|. Coq is an interactive theorem +This is the reference manual of |Coq|. |Coq| is an interactive theorem prover. It lets you formalize mathematical concepts and then helps you interactively generate machine-checked proofs of theorems. Machine checking gives users much more confidence that the proofs are -correct compared to human-generated and -checked proofs. Coq has been +correct compared to human-generated and -checked proofs. |Coq| has been used in a number of flagship verification projects, including the `CompCert verified C compiler <http://compcert.inria.fr/>`_, and has served to verify the proof of the `four color theorem @@ -18,49 +18,49 @@ arithmetic). :ref:`Ltac <ltac>` and its planned replacement, combining existing tactics with looping and conditional constructs. These permit automation of large parts of proofs and sometimes entire proofs. Furthermore, users can add novel tactics or functionality by -creating Coq plugins using OCaml. +creating |Coq| plugins using |OCaml|. -The Coq kernel, a small part of Coq, does the final verification that +The |Coq| kernel, a small part of |Coq|, does the final verification that the tactic-generated proof is valid. Usually the tactic-generated proof is indeed correct, but delegating proof verification to the kernel means that even if a tactic is buggy, it won't be able to introduce an incorrect proof into the system. -Finally, Coq also supports extraction of verified programs to -programming languages such as OCaml and Haskell. This provides a way -of executing Coq code efficiently and can be used to create verified +Finally, |Coq| also supports extraction of verified programs to +programming languages such as |OCaml| and Haskell. This provides a way +of executing |Coq| code efficiently and can be used to create verified software libraries. -To learn Coq, beginners are advised to first start with a tutorial / +To learn |Coq|, beginners are advised to first start with a tutorial / book. Several such tutorials / books are listed at https://coq.inria.fr/documentation. This manual is organized in three main parts, plus an appendix: -- **The first part presents the specification language of Coq**, that +- **The first part presents the specification language of |Coq|**, that allows to define programs and state mathematical theorems. - :ref:`core-language` presents the language that the kernel of Coq + :ref:`core-language` presents the language that the kernel of |Coq| understands. :ref:`extensions` presents the richer language, with notations, implicits, etc. that a user can use and which is translated down to the language of the kernel by means of an "elaboration process". - **The second part presents the interactive proof mode**, the central - feature of Coq. :ref:`writing-proofs` introduces this interactive + feature of |Coq|. :ref:`writing-proofs` introduces this interactive proof mode and the available proof languages. :ref:`automatic-tactics` presents some more advanced tactics, while :ref:`writing-tactics` is about the languages that allow a user to combine tactics together and develop new ones. -- **The third part shows how to use Coq in practice.** +- **The third part shows how to use |Coq| in practice.** :ref:`libraries` presents some of the essential reusable blocks from the ecosystem and some particularly important extensions such as the program extraction mechanism. :ref:`tools` documents important - tools that a user needs to build a Coq project. + tools that a user needs to build a |Coq| project. - In the appendix, :ref:`history-and-changes` presents the history of - Coq and changes in recent releases. This is an important reference - if you upgrade the version of Coq that you use. The various + |Coq| and changes in recent releases. This is an important reference + if you upgrade the version of |Coq| that you use. The various :ref:`indexes <indexes>` are very useful to **quickly browse the manual and find what you are looking for.** They are often the main entry point to the manual. diff --git a/doc/sphinx/language/core/assumptions.rst b/doc/sphinx/language/core/assumptions.rst index fe10e345cd..a38282d41a 100644 --- a/doc/sphinx/language/core/assumptions.rst +++ b/doc/sphinx/language/core/assumptions.rst @@ -117,7 +117,7 @@ Assumptions Assumptions extend the environment with axioms, parameters, hypotheses or variables. An assumption binds an :n:`@ident` to a :n:`@type`. It is accepted -by Coq if and only if this :n:`@type` is a correct type in the environment +by |Coq| if and only if this :n:`@type` is a correct type in the environment preexisting the declaration and if :n:`@ident` was not previously defined in the same module. This :n:`@type` is considered to be the type (or specification, or statement) assumed by :n:`@ident` and we say that :n:`@ident` @@ -138,11 +138,11 @@ has type :n:`@type`. | {| Variable | Variables } assumpt ::= {+ @ident_decl } @of_type ident_decl ::= @ident {? @univ_decl } - of_type ::= {| : | :> | :>> } @type + of_type ::= {| : | :> } @type These commands bind one or more :n:`@ident`\(s) to specified :n:`@type`\(s) as their specifications in - the global context. The fact asserted by the :n:`@type` (or, equivalently, the existence - of an object of this type) is accepted as a postulate. + the global context. The fact asserted by :n:`@type` (or, equivalently, the existence + of an object of this type) is accepted as a postulate. They accept the :attr:`program` attribute. :cmd:`Axiom`, :cmd:`Conjecture`, :cmd:`Parameter` and their plural forms are equivalent. They can take the :attr:`local` :term:`attribute`, @@ -155,6 +155,10 @@ has type :n:`@type`. is closed, the :n:`@ident`\(s) become undefined and every object depending on them will be explicitly parameterized (i.e., the variables are *discharged*). See Section :ref:`section-mechanism`. + :n:`:>` + If specified, :token:`ident_decl` is automatically + declared as a coercion to the class of its type. See :ref:`coercions`. + The :n:`Inline` clause is only relevant inside functors. See :cmd:`Module`. .. example:: Simple assumptions diff --git a/doc/sphinx/language/core/basic.rst b/doc/sphinx/language/core/basic.rst index 45bdc019ac..29a2b40162 100644 --- a/doc/sphinx/language/core/basic.rst +++ b/doc/sphinx/language/core/basic.rst @@ -134,7 +134,7 @@ Numbers hexdigit ::= {| 0 .. 9 | a .. f | A .. F } :n:`@integer` and :n:`@natural` are limited to the range that fits - into an OCaml integer (63-bit integers on most architectures). + into an |OCaml| integer (63-bit integers on most architectures). :n:`@bigint` and :n:`@bignat` have no range limitation. The :ref:`standard library <thecoqlibrary>` provides some @@ -152,8 +152,8 @@ Strings :token:`string`. Keywords - The following character sequences are keywords defined in the main Coq grammar - that cannot be used as identifiers (even when starting Coq with the `-noinit` + The following character sequences are keywords defined in the main |Coq| grammar + that cannot be used as identifiers (even when starting |Coq| with the `-noinit` command-line flag):: _ Axiom CoFixpoint Definition Fixpoint Hypothesis Parameter Prop @@ -168,11 +168,11 @@ Keywords keywords. Other tokens - The following character sequences are tokens defined in the main Coq grammar - (even when starting Coq with the `-noinit` command-line flag):: + The following character sequences are tokens defined in the main |Coq| grammar + (even when starting |Coq| with the `-noinit` command-line flag):: ! #[ % & ' ( () ) * + , - -> - . .( .. ... / : ::= := :> :>> ; < <+ <- <: + . .( .. ... / : ::= := :> ; < <+ <- <: <<: <= = => > >-> >= ? @ @{ [ ] _ `( `{ { {| | } @@ -325,10 +325,10 @@ rest of the |Coq| manual: :term:`terms <term>` and :term:`types boldface label "Command:". Commands are listed in the :ref:`command_index`. Example: - .. cmd:: Comments {* @string } + .. cmd:: Comments {* {| @one_term | @string | @natural } } - This command prints "Comments ok" and does not change anything - to the state of the document. + Prints "Comments ok" and does not change + the state of the document. tactic diff --git a/doc/sphinx/language/core/coinductive.rst b/doc/sphinx/language/core/coinductive.rst index c034b7f302..0520afd600 100644 --- a/doc/sphinx/language/core/coinductive.rst +++ b/doc/sphinx/language/core/coinductive.rst @@ -76,7 +76,7 @@ propositional η-equality, which itself would require full η-conversion for subject reduction to hold, but full η-conversion is not acceptable as it would make type checking undecidable. -Since the introduction of primitive records in Coq 8.5, an alternative +Since the introduction of primitive records in |Coq| 8.5, an alternative presentation is available, called *negative co-inductive types*. This consists in defining a co-inductive type as a primitive record type through its projections. Such a technique is akin to the *co-pattern* style that can be @@ -115,7 +115,7 @@ equality: Axiom Stream_ext : forall (s1 s2: Stream), EqSt s1 s2 -> s1 = s2. -As of Coq 8.9, it is now advised to use negative co-inductive types rather than +As of |Coq| 8.9, it is now advised to use negative co-inductive types rather than their positive counterparts. .. seealso:: @@ -195,7 +195,7 @@ Top-level definitions of co-recursive functions As in the :cmd:`Fixpoint` command, the :n:`with` clause allows simultaneously defining several mutual cofixpoints. - If :n:`@term` is omitted, :n:`@type` is required and Coq enters proof editing mode. + If :n:`@term` is omitted, :n:`@type` is required and |Coq| enters proof editing mode. This can be used to define a term incrementally, in particular by relying on the :tacn:`refine` tactic. In this case, the proof should be terminated with :cmd:`Defined` in order to define a constant for which the computational behavior is relevant. See :ref:`proof-editing-mode`. diff --git a/doc/sphinx/language/core/definitions.rst b/doc/sphinx/language/core/definitions.rst index 42203d9d65..8d67a3cf40 100644 --- a/doc/sphinx/language/core/definitions.rst +++ b/doc/sphinx/language/core/definitions.rst @@ -87,10 +87,10 @@ Section :ref:`typing-rules`. computation on :n:`@term`. These commands also support the :attr:`universes(polymorphic)`, - :attr:`universes(monomorphic)`, :attr:`program` and + :attr:`universes(monomorphic)`, :attr:`program` (see :ref:`program_definition`) and :attr:`canonical` attributes. - If :n:`@term` is omitted, :n:`@type` is required and Coq enters proof editing mode. + If :n:`@term` is omitted, :n:`@type` is required and |Coq| enters proof editing mode. This can be used to define a term incrementally, in particular by relying on the :tacn:`refine` tactic. In this case, the proof should be terminated with :cmd:`Defined` in order to define a constant for which the computational behavior is relevant. See :ref:`proof-editing-mode`. @@ -135,11 +135,13 @@ Chapter :ref:`Tactics`. The basic assertion command is: | Proposition | Property - After the statement is asserted, Coq needs a proof. Once a proof of + After the statement is asserted, |Coq| needs a proof. Once a proof of :n:`@type` under the assumptions represented by :n:`@binder`\s is given and validated, the proof is generalized into a proof of :n:`forall {* @binder }, @type` and the theorem is bound to the name :n:`@ident` in the environment. + These commands accept the :attr:`program` attribute. See :ref:`program_lemma`. + Forms using the :n:`with` clause are useful for theorems that are proved by simultaneous induction over a mutually inductive assumption, or that assert mutually dependent statements in some mutual co-inductive type. It is equivalent to @@ -172,7 +174,7 @@ Chapter :ref:`Tactics`. The basic assertion command is: This feature, called nested proofs, is disabled by default. To activate it, turn the :flag:`Nested Proofs Allowed` flag on. -Proofs start with the keyword :cmd:`Proof`. Then Coq enters the proof editing mode +Proofs start with the keyword :cmd:`Proof`. Then |Coq| enters the proof editing mode until the proof is completed. In proof editing mode, the user primarily enters tactics, which are described in chapter :ref:`Tactics`. The user may also enter commands to manage the proof editing mode. They are described in Chapter diff --git a/doc/sphinx/language/core/index.rst b/doc/sphinx/language/core/index.rst index de780db267..c7b1df28db 100644 --- a/doc/sphinx/language/core/index.rst +++ b/doc/sphinx/language/core/index.rst @@ -4,7 +4,7 @@ Core language ============= -At the heart of the Coq proof assistant is the Coq kernel. While +At the heart of the |Coq| proof assistant is the |Coq| kernel. While users have access to a language with many convenient features such as :ref:`notations <syntax-extensions-and-notation-scopes>`, :ref:`implicit arguments <ImplicitArguments>`, etc. (presented in the diff --git a/doc/sphinx/language/core/inductive.rst b/doc/sphinx/language/core/inductive.rst index 4cdfba146a..122b0f5dfb 100644 --- a/doc/sphinx/language/core/inductive.rst +++ b/doc/sphinx/language/core/inductive.rst @@ -13,11 +13,11 @@ Inductive types .. prodn:: inductive_definition ::= {? > } @ident_decl {* @binder } {? %| {* @binder } } {? : @type } {? := {? @constructors_or_record } } {? @decl_notations } constructors_or_record ::= {? %| } {+| @constructor } - | {? @ident } %{ {*; @record_field } %} + | {? @ident } %{ {*; @record_field } {? ; } %} constructor ::= @ident {* @binder } {? @of_type } This command defines one or more - inductive types and its constructors. Coq generates destructors + inductive types and its constructors. |Coq| generates destructors depending on the universe that the inductive type belongs to. The destructors are named :n:`@ident`\ ``_rect``, :n:`@ident`\ ``_ind``, @@ -361,7 +361,11 @@ syntax: :n:`let fix @ident {* @binder } := @term in` stands for Some options of :n:`@fixannot` are only supported in specific constructs. :n:`fix` and :n:`let fix` only support the :n:`struct` option, while :n:`wf` and :n:`measure` are only supported in -commands such as :cmd:`Function` and :cmd:`Program Fixpoint`. +commands such as :cmd:`Fixpoint` (with the :attr:`program` attribute) and :cmd:`Function`. + +.. todo explanation of struct: see text above at the Fixpoint command, also + see https://github.com/coq/coq/pull/12936#discussion_r510716268 and above. + Consider whether to move the grammar for fixannot elsewhere .. _Fixpoint: @@ -379,7 +383,7 @@ constructions. .. prodn:: fix_definition ::= @ident_decl {* @binder } {? @fixannot } {? : @type } {? := @term } {? @decl_notations } - This command allows defining functions by pattern matching over inductive + Allows defining functions by pattern matching over inductive objects using a fixed point construction. The meaning of this declaration is to define :n:`@ident` as a recursive function with arguments specified by the :n:`@binder`\s such that :n:`@ident` applied to arguments @@ -388,6 +392,8 @@ constructions. consequently :n:`forall {* @binder }, @type` and its value is equivalent to :n:`fun {* @binder } => @term`. + This command accepts the :attr:`program` attribute. + To be accepted, a :cmd:`Fixpoint` definition has to satisfy syntactical constraints on a special argument called the decreasing argument. They are needed to ensure that the :cmd:`Fixpoint` definition always terminates. @@ -399,13 +405,13 @@ constructions. that satisfies the decreasing condition. :cmd:`Fixpoint` without the :attr:`program` attribute does not support the - :n:`wf` or :n:`measure` clauses of :n:`@fixannot`. + :n:`wf` or :n:`measure` clauses of :n:`@fixannot`. See :ref:`program_fixpoint`. The :n:`with` clause allows simultaneously defining several mutual fixpoints. It is especially useful when defining functions over mutually defined inductive types. Example: :ref:`Mutual Fixpoints<example_mutual_fixpoints>`. - If :n:`@term` is omitted, :n:`@type` is required and Coq enters proof editing mode. + If :n:`@term` is omitted, :n:`@type` is required and |Coq| enters proof editing mode. This can be used to define a term incrementally, in particular by relying on the :tacn:`refine` tactic. In this case, the proof should be terminated with :cmd:`Defined` in order to define a constant for which the computational behavior is relevant. See :ref:`proof-editing-mode`. diff --git a/doc/sphinx/language/core/modules.rst b/doc/sphinx/language/core/modules.rst index 866104d5d1..1309a47ff4 100644 --- a/doc/sphinx/language/core/modules.rst +++ b/doc/sphinx/language/core/modules.rst @@ -1001,12 +1001,12 @@ of the ``Require`` command can be used to bypass the implicit shortening by providing an absolute root to the required file (see :ref:`compiled-files`). There also exists another independent loadpath mechanism attached to -OCaml object files (``.cmo`` or ``.cmxs``) rather than |Coq| object -files as described above. The OCaml loadpath is managed using -the option ``-I`` `path` (in the OCaml world, there is neither a +|OCaml| object files (``.cmo`` or ``.cmxs``) rather than |Coq| object +files as described above. The |OCaml| loadpath is managed using +the option ``-I`` `path` (in the |OCaml| world, there is neither a notion of logical name prefix nor a way to access files in subdirectories of path). See the command :cmd:`Declare ML Module` in -:ref:`compiled-files` to understand the need of the OCaml loadpath. +:ref:`compiled-files` to understand the need of the |OCaml| loadpath. See :ref:`command-line-options` for a more general view over the |Coq| command line options. diff --git a/doc/sphinx/language/core/primitive.rst b/doc/sphinx/language/core/primitive.rst index 48647deeff..17f569ca2a 100644 --- a/doc/sphinx/language/core/primitive.rst +++ b/doc/sphinx/language/core/primitive.rst @@ -45,13 +45,13 @@ applications of these primitive operations. The extraction of these primitives can be customized similarly to the extraction of regular axioms (see :ref:`extraction`). Nonetheless, the :g:`ExtrOCamlInt63` -module can be used when extracting to OCaml: it maps the Coq primitives to types -and functions of a :g:`Uint63` module. Said OCaml module is not produced by +module can be used when extracting to |OCaml|: it maps the |Coq| primitives to types +and functions of a :g:`Uint63` module. That |OCaml| module is not produced by extraction. Instead, it has to be provided by the user (if they want to compile or execute the extracted code). For instance, an implementation of this module -can be taken from the kernel of Coq. +can be taken from the kernel of |Coq|. -Literal values (at type :g:`Int63.int`) are extracted to literal OCaml values +Literal values (at type :g:`Int63.int`) are extracted to literal |OCaml| values wrapped into the :g:`Uint63.of_int` (resp. :g:`Uint63.of_int64`) constructor on 64-bit (resp. 32-bit) platforms. Currently, this cannot be customized (see the function :g:`Uint63.compile` from the kernel). @@ -94,13 +94,13 @@ to comply with the IEEE 754 standard for floating-point arithmetic. The extraction of these primitives can be customized similarly to the extraction of regular axioms (see :ref:`extraction`). Nonetheless, the :g:`ExtrOCamlFloats` -module can be used when extracting to OCaml: it maps the Coq primitives to types -and functions of a :g:`Float64` module. Said OCaml module is not produced by +module can be used when extracting to |OCaml|: it maps the |Coq| primitives to types +and functions of a :g:`Float64` module. Said |OCaml| module is not produced by extraction. Instead, it has to be provided by the user (if they want to compile or execute the extracted code). For instance, an implementation of this module -can be taken from the kernel of Coq. +can be taken from the kernel of |Coq|. -Literal values (of type :g:`Float64.t`) are extracted to literal OCaml +Literal values (of type :g:`Float64.t`) are extracted to literal |OCaml| values (of type :g:`float`) written in hexadecimal notation and wrapped into the :g:`Float64.of_float` constructor, e.g.: :g:`Float64.of_float (0x1p+0)`. @@ -144,19 +144,19 @@ operations. The extraction of these primitives can be customized similarly to the extraction of regular axioms (see :ref:`extraction`). Nonetheless, the :g:`ExtrOCamlPArray` -module can be used when extracting to OCaml: it maps the Coq primitives to types -and functions of a :g:`Parray` module. Said OCaml module is not produced by +module can be used when extracting to |OCaml|: it maps the |Coq| primitives to types +and functions of a :g:`Parray` module. Said |OCaml| module is not produced by extraction. Instead, it has to be provided by the user (if they want to compile or execute the extracted code). For instance, an implementation of this module -can be taken from the kernel of Coq (see ``kernel/parray.ml``). +can be taken from the kernel of |Coq| (see ``kernel/parray.ml``). -Coq's primitive arrays are persistent data structures. Semantically, a set operation +|Coq|'s primitive arrays are persistent data structures. Semantically, a set operation ``t.[i <- a]`` represents a new array that has the same values as ``t``, except at position ``i`` where its value is ``a``. The array ``t`` still exists, can still be used and its values were not modified. Operationally, the implementation -of Coq's primitive arrays is optimized so that the new array ``t.[i <- a]`` does not +of |Coq|'s primitive arrays is optimized so that the new array ``t.[i <- a]`` does not copy all of ``t``. The details are in section 2.3 of :cite:`ConchonFilliatre07wml`. -In short, the implementation keeps one version of ``t`` as an OCaml native array and +In short, the implementation keeps one version of ``t`` as an |OCaml| native array and other versions as lists of modifications to ``t``. Accesses to the native array version are constant time operations. However, accesses to versions where all the cells of the array are modified have O(n) access time, the same as a list. The version that is kept as the native array diff --git a/doc/sphinx/language/core/records.rst b/doc/sphinx/language/core/records.rst index cd44d06e67..e6df3ee9f5 100644 --- a/doc/sphinx/language/core/records.rst +++ b/doc/sphinx/language/core/records.rst @@ -18,27 +18,36 @@ expressions. In this sense, the :cmd:`Record` construction allows defining .. insertprodn record_definition field_def .. prodn:: - record_definition ::= {? > } @ident_decl {* @binder } {? : @type } {? @ident } %{ {*; @record_field } %} {? @decl_notations } + record_definition ::= {? > } @ident_decl {* @binder } {? : @sort } {? := {? @ident } %{ {*; @record_field } {? ; } %} } record_field ::= {* #[ {*, @attribute } ] } @name {? @field_body } {? %| @natural } {? @decl_notations } field_body ::= {* @binder } @of_type | {* @binder } @of_type := @term | {* @binder } := @term - term_record ::= %{%| {* @field_def } %|%} + term_record ::= %{%| {*; @field_def } {? ; } %|%} field_def ::= @qualid {* @binder } := @term - Each :n:`@record_definition` defines a record named by :n:`@ident_decl`. The constructor name is given by :n:`@ident`. If the constructor name is not specified, then the default name :n:`Build_@ident` is used, where :n:`@ident` is the record name. - If :n:`@type` is - omitted, the default type is :math:`\Type`. The identifiers inside the brackets are the field names. - The type of each field :n:`@ident` is :n:`forall {* @binder }, @type`. + If :token:`sort` is omitted, the default sort is Type. Notice that the type of an identifier can depend on a previously-given identifier. Thus the order of the fields is important. :n:`@binder` parameters may be applied to the record as a whole or to individual fields. + .. todo + "Record foo2:Prop := { a }." gives the error "Cannot infer this placeholder of type "Type", + while "Record foo2:Prop := { a:Type }." gives the output "foo2 is defined. + a cannot be defined because it is informative and foo2 is not." + Your thoughts? + + :n:`{? > }` + If provided, the constructor name is automatically declared as + a coercion from the class of the last field type to the record name + (this may fail if the uniform inheritance condition is not + satisfied). See :ref:`coercions`. + Notations can be attached to fields using the :n:`@decl_notations` annotation. :cmd:`Record` and :cmd:`Structure` are synonyms. @@ -76,7 +85,7 @@ Let us now see the work done by the ``Record`` macro. First the macro generates a variant type definition with just one constructor: :n:`Variant @ident {* @binder } : @sort := @ident__0 {* @binder }`. -To build an object of type :token:`ident`, one should provide the constructor +To build an object of type :token:`ident`, provide the constructor :n:`@ident__0` with the appropriate number of terms filling the fields of the record. .. example:: diff --git a/doc/sphinx/language/core/sections.rst b/doc/sphinx/language/core/sections.rst index df50dbafe3..c70f7a347b 100644 --- a/doc/sphinx/language/core/sections.rst +++ b/doc/sphinx/language/core/sections.rst @@ -84,7 +84,7 @@ Sections create local contexts which can be shared across multiple definitions. will be wrapped with a :n:`@term_let` with the same declaration. As for :cmd:`Definition`, :cmd:`Fixpoint` and :cmd:`CoFixpoint`, - if :n:`@term` is omitted, :n:`@type` is required and Coq enters proof editing mode. + if :n:`@term` is omitted, :n:`@type` is required and |Coq| enters proof editing mode. This can be used to define a term incrementally, in particular by relying on the :tacn:`refine` tactic. In this case, the proof should be terminated with :cmd:`Defined` in order to define a constant for which the computational behavior is relevant. See :ref:`proof-editing-mode`. diff --git a/doc/sphinx/language/core/variants.rst b/doc/sphinx/language/core/variants.rst index 2904250e41..645986be9c 100644 --- a/doc/sphinx/language/core/variants.rst +++ b/doc/sphinx/language/core/variants.rst @@ -29,6 +29,7 @@ Private (matching) inductive types ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. attr:: private(matching) + :name: private(matching); Private This attribute can be used to forbid the use of the :g:`match` construct on objects of this inductive type outside of the module diff --git a/doc/sphinx/language/extensions/arguments-command.rst b/doc/sphinx/language/extensions/arguments-command.rst index 0ae9fab7ab..29877e1b32 100644 --- a/doc/sphinx/language/extensions/arguments-command.rst +++ b/doc/sphinx/language/extensions/arguments-command.rst @@ -377,7 +377,7 @@ Effects of :cmd:`Arguments` on unfolding Bidirectionality hints ~~~~~~~~~~~~~~~~~~~~~~ -When type-checking an application, Coq normally does not use information from +When type-checking an application, |Coq| normally does not use information from the context to infer the types of the arguments. It only checks after the fact that the type inferred for the application is coherent with the expected type. Bidirectionality hints make it possible to specify that after type-checking the @@ -394,7 +394,7 @@ the context to help inferring the types of the remaining arguments. * *type inference*, with is inferring the type of a construct by analyzing the construct. Methods that combine these approaches are known as *bidirectional typing*. - Coq normally uses only the first approach to infer the types of arguments, + |Coq| normally uses only the first approach to infer the types of arguments, then later verifies that the inferred type is consistent with the expected type. *Bidirectionality hints* specify to use both methods: after type checking the first arguments of an application (appearing before the `&` in :cmd:`Arguments`), @@ -416,7 +416,7 @@ type check the remaining arguments (in :n:`@arg_specs__2`). Definition b2n (b : bool) := if b then 1 else 0. Coercion b2n : bool >-> nat. - Coq cannot automatically coerce existential statements over ``bool`` to + |Coq| cannot automatically coerce existential statements over ``bool`` to statements over ``nat``, because the need for inserting a coercion is known only from the expected type of a subterm: @@ -431,7 +431,7 @@ type check the remaining arguments (in :n:`@arg_specs__2`). Arguments ex_intro _ _ & _ _. Check (ex_intro _ true _ : exists n : nat, n > 0). -Coq will attempt to produce a term which uses the arguments you +|Coq| will attempt to produce a term which uses the arguments you provided, but in some cases involving Program mode the arguments after the bidirectionality starts may be replaced by convertible but syntactically different terms. diff --git a/doc/sphinx/language/extensions/canonical.rst b/doc/sphinx/language/extensions/canonical.rst index bfda8befff..38c9fa336d 100644 --- a/doc/sphinx/language/extensions/canonical.rst +++ b/doc/sphinx/language/extensions/canonical.rst @@ -159,7 +159,7 @@ of the terms that are compared. End theory. End EQ. -We use Coq modules as namespaces. This allows us to follow the same +We use |Coq| modules as namespaces. This allows us to follow the same pattern and naming convention for the rest of the chapter. The base namespace contains the definitions of the algebraic structure. To keep the example small, the algebraic structure ``EQ.type`` we are @@ -224,7 +224,7 @@ example work: Fail Check forall (e : EQ.type) (a b : EQ.obj e), (a, b) == (a, b). The error message is telling that |Coq| has no idea on how to compare -pairs of objects. The following construction is telling Coq exactly +pairs of objects. The following construction is telling |Coq| exactly how to do that. .. coqtop:: all diff --git a/doc/sphinx/language/extensions/evars.rst b/doc/sphinx/language/extensions/evars.rst index 20f4310d13..dc208a63a0 100644 --- a/doc/sphinx/language/extensions/evars.rst +++ b/doc/sphinx/language/extensions/evars.rst @@ -68,7 +68,7 @@ Inferable subterms ~~~~~~~~~~~~~~~~~~ Expressions often contain redundant pieces of information. Subterms that can be -automatically inferred by Coq can be replaced by the symbol ``_`` and Coq will +automatically inferred by |Coq| can be replaced by the symbol ``_`` and |Coq| will guess the missing piece of information. .. extracted from Gallina extensions chapter diff --git a/doc/sphinx/language/extensions/implicit-arguments.rst b/doc/sphinx/language/extensions/implicit-arguments.rst index f8375e93ce..9457505feb 100644 --- a/doc/sphinx/language/extensions/implicit-arguments.rst +++ b/doc/sphinx/language/extensions/implicit-arguments.rst @@ -115,7 +115,7 @@ application will include that argument. Otherwise, the argument is *non-maximally inserted* and the partial application will not include that argument. Each implicit argument can be declared to be inserted maximally or non -maximally. In Coq, maximally inserted implicit arguments are written between curly braces +maximally. In |Coq|, maximally inserted implicit arguments are written between curly braces "{ }" and non-maximally inserted implicit arguments are written in square brackets "[ ]". .. seealso:: :flag:`Maximal Implicit Insertion` diff --git a/doc/sphinx/language/extensions/index.rst b/doc/sphinx/language/extensions/index.rst index ed207ca743..ea7271179e 100644 --- a/doc/sphinx/language/extensions/index.rst +++ b/doc/sphinx/language/extensions/index.rst @@ -4,7 +4,7 @@ Language extensions =================== -Elaboration extends the language accepted by the Coq kernel to make it +Elaboration extends the language accepted by the |Coq| kernel to make it easier to use. For example, this lets the user omit most type annotations because they can be inferred, call functions with implicit arguments which will be inferred as well, extend the syntax with diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst index e6188b8023..3c1983ee97 100644 --- a/doc/sphinx/language/extensions/match.rst +++ b/doc/sphinx/language/extensions/match.rst @@ -676,7 +676,7 @@ Dependent pattern matching ~~~~~~~~~~~~~~~~~~~~~~~~~~ The examples given so far do not need an explicit elimination -predicate because all the |rhs| have the same type and Coq +predicate because all the |rhs| have the same type and |Coq| succeeds to synthesize it. Unfortunately when dealing with dependent patterns it often happens that we need to write cases where the types of the |rhs| are different instances of the elimination predicate. The diff --git a/doc/sphinx/practical-tools/coq-commands.rst b/doc/sphinx/practical-tools/coq-commands.rst index ec182ce08f..59e1c65a49 100644 --- a/doc/sphinx/practical-tools/coq-commands.rst +++ b/doc/sphinx/practical-tools/coq-commands.rst @@ -24,13 +24,13 @@ develop his theories and proofs step by step. The |Coq| toplevel is run by the command ``coqtop``. There are two different binary images of |Coq|: the byte-code one and the -native-code one (if OCaml provides a native-code compiler for +native-code one (if |OCaml| provides a native-code compiler for your platform, which is supposed in the following). By default, ``coqtop`` executes the native-code version; run ``coqtop.byte`` to get the byte-code version. -The byte-code toplevel is based on an OCaml toplevel (to -allow dynamic linking of tactics). You can switch to the OCaml toplevel +The byte-code toplevel is based on an |OCaml| toplevel (to +allow dynamic linking of tactics). You can switch to the |OCaml| toplevel with the command ``Drop.``, and come back to the |Coq| toplevel with the command ``Coqloop.loop();;``. @@ -61,7 +61,7 @@ By resource file When |Coq| is launched, with either ``coqtop`` or ``coqc``, the resource file ``$XDG_CONFIG_HOME/coq/coqrc.xxx``, if it exists, will -be implicitly prepended to any document read by Coq, whether it is an +be implicitly prepended to any document read by |Coq|, whether it is an interactive session or a file to compile. Here, ``$XDG_CONFIG_HOME`` is the configuration directory of the user (by default it's ``~/.config``) and ``xxx`` is the version number (e.g. 8.8). If @@ -133,7 +133,7 @@ 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. + to the |OCaml| loadpath. .. seealso:: @@ -253,8 +253,8 @@ and ``coqtop``, unless stated otherwise: .. 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. Within Coq, the :flag:`Mangle Names` flag turns this behavior on, + |Coq|'s auto-generated name scheme with names of the form *ident0*, *ident1*, + etc. Within |Coq|, the :flag:`Mangle Names` flag turns this behavior on, and the :opt:`Mangle Names Prefix` option sets the prefix to use. This feature is intended to be used as a linter for developments that want to be robust to changes in the auto-generated name scheme. The options are provided to @@ -264,7 +264,7 @@ and ``coqtop``, unless stated otherwise: type of the option. For flags :n:`@setting_name` is equivalent to :n:`@setting_name=true`. For instance ``-set "Universe Polymorphism"`` will enable :flag:`Universe Polymorphism`. Note that the quotes are - shell syntax, Coq does not see them. + shell syntax, |Coq| does not see them. See the :ref:`note above <interleave-command-line>` regarding the order of command-line options. :-unset *string*: As ``-set`` but used to disable options and flags. @@ -304,7 +304,7 @@ and ``coqtop``, unless stated otherwise: Compiled interfaces (produced using ``-vos``) ---------------------------------------------- -Compiled interfaces help saving time while developing Coq formalizations, +Compiled interfaces help saving time while developing |Coq| formalizations, by compiling the formal statements exported by a library independently of the proofs that it contains. @@ -473,7 +473,7 @@ set of reflexive transitive dependencies of set :math:`S`. Then: 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 +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 course, the latter is slightly slower since it makes more disk access. diff --git a/doc/sphinx/practical-tools/coqide.rst b/doc/sphinx/practical-tools/coqide.rst index 42e752841d..64b433115c 100644 --- a/doc/sphinx/practical-tools/coqide.rst +++ b/doc/sphinx/practical-tools/coqide.rst @@ -5,9 +5,9 @@ |Coq| Integrated Development Environment ======================================== -The Coq Integrated Development Environment is a graphical tool, to be +The |Coq| Integrated Development Environment is a graphical tool, to be used as a user-friendly replacement to `coqtop`. Its main purpose is to -allow the user to navigate forward and backward into a Coq vernacular +allow the user to navigate forward and backward into a |Coq| vernacular file, executing corresponding commands or undoing them respectively. |CoqIDE| is run by typing the command `coqide` on the command line. @@ -23,7 +23,7 @@ no meaning for |CoqIDE| being ignored. :alt: |CoqIDE| main screen A sample |CoqIDE| main screen, while navigating into a file `Fermat.v`, -is shown in the figure :ref:`CoqIDE main screen <coqide_mainscreen>`. +is shown in the figure :ref:`|CoqIDE| main screen <coqide_mainscreen>`. At the top is a menu bar, and a tool bar below it. The large window on the left is displaying the various *script buffers*. The upper right window is the *goal window*, where @@ -39,7 +39,7 @@ The *File* menu allows you to open files or create some, save them, print or export them into various formats. Among all these buffers, there is always one which is the current *running buffer*, whose name is displayed on a background in the *processed* color (green by default), which -is the one where Coq commands are currently executed. +is the one where |Coq| commands are currently executed. Buffers may be edited as in any text editor, and classical basic editing commands (Copy/Paste, …) are available in the *Edit* menu. @@ -47,7 +47,7 @@ editing commands (Copy/Paste, …) are available in the *Edit* menu. editing commands, you may launch your favorite text editor on the current buffer, using the *Edit/External Editor* menu. -Interactive navigation into Coq scripts +Interactive navigation into |Coq| scripts -------------------------------------------- The running buffer is the one where navigation takes place. The toolbar offers @@ -58,7 +58,7 @@ processed color. If that command fails, the error message is displayed in the message window, and the location of the error is emphasized by an underline in the error foreground color (red by default). -In the figure :ref:`CoqIDE main screen <coqide_mainscreen>`, +In the figure :ref:`|CoqIDE| main screen <coqide_mainscreen>`, the running buffer is `Fermat.v`, all commands until the ``Theorem`` have been already executed, and the user tried to go forward executing ``Induction n``. That command failed because no such @@ -153,7 +153,7 @@ as standard |GtkSourceView| styles are available. Other styles can be added e.g. in ``$HOME/.local/share/gtksourceview-3.0/styles/`` (see the general documentation about |GtkSourceView| for the various possibilities). Note that the style of the rest of graphical part of -Coqide is not under the control of |GtkSourceView| but of GTK+ and +|CoqIDE| is not under the control of |GtkSourceView| but of GTK+ and governed by files such as ``settings.ini`` and ``gtk.css`` in ``$XDG_CONFIG_HOME/gtk-3.0`` or files in ``$HOME/.themes/NameOfTheme/gtk-3.0``, as well as the environment @@ -219,7 +219,7 @@ mathematical symbols ∀ and ∃, you may define: : type_scope. There exists a small set of such notations already defined, in the -file `utf8.v` of Coq library, so you may enable them just by +file `utf8.v` of |Coq| library, so you may enable them just by ``Require Import Unicode.Utf8`` inside |CoqIDE|, or equivalently, by starting |CoqIDE| with ``coqide -l utf8``. @@ -237,7 +237,7 @@ use antialiased fonts or not, by setting the environment variable Bindings for input of Unicode symbols ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CoqIDE supports a builtin mechanism to input non-ASCII symbols. +|CoqIDE| supports a builtin mechanism to input non-ASCII symbols. For example, to input ``π``, it suffices to type ``\pi`` then press the combination of key ``Shift+Space`` (default key binding). Often, it suffices to type a prefix of the latex token, e.g. typing ``\p`` diff --git a/doc/sphinx/practical-tools/utilities.rst b/doc/sphinx/practical-tools/utilities.rst index daae46ad11..c3286199e8 100644 --- a/doc/sphinx/practical-tools/utilities.rst +++ b/doc/sphinx/practical-tools/utilities.rst @@ -8,8 +8,8 @@ The distribution provides utilities to simplify some tedious works beside proof development, tactics writing or documentation. -Using Coq as a library ----------------------- +Using |Coq| as a library +------------------------ In previous versions, ``coqmktop`` was used to build custom toplevels - for example for better debugging or custom static @@ -37,10 +37,10 @@ and similarly for other plugins. Building a |Coq| project ------------------------ -As of today it is possible to build Coq projects using two tools: +As of today it is possible to build |Coq| projects using two tools: -- coq_makefile, which is distributed by Coq and is based on generating a makefile, -- Dune, the standard OCaml build tool, which, since version 1.9, supports building Coq libraries. +- coq_makefile, which is distributed by |Coq| and is based on generating a makefile, +- Dune, the standard |OCaml| build tool, which, since version 1.9, supports building |Coq| libraries. .. _coq_makefile: @@ -142,7 +142,7 @@ Here we describe only few of them. :CAMLPKGS: can be used to specify third party findlib packages, and is - passed to the OCaml compiler on building or linking of modules. Eg: + passed to the |OCaml| compiler on building or linking of modules. Eg: ``-package yojson``. :CAMLFLAGS: can be used to specify additional flags to the |OCaml| @@ -150,15 +150,15 @@ Here we describe only few of them. :OCAMLWARN: it contains a default of ``-warn-error +a-3``, useful to modify this setting; beware this is not recommended for projects in - Coq's CI. + |Coq|'s CI. :COQC, COQDEP, COQDOC: can be set in order to use alternative binaries (e.g. wrappers) :COQ_SRC_SUBDIRS: can be extended by including other paths in which ``*.cm*`` files are searched. For example ``COQ_SRC_SUBDIRS+=user-contrib/Unicoq`` - lets you build a plugin containing OCaml code that depends on the - OCaml code of ``Unicoq`` + lets you build a plugin containing |OCaml| code that depends on the + |OCaml| code of ``Unicoq`` :COQFLAGS: override the flags passed to ``coqc``. By default ``-q``. :COQEXTRAFLAGS: @@ -172,7 +172,7 @@ Here we describe only few of them. :COQDOCEXTRAFLAGS: extend the flags passed to ``coqdoc`` :COQLIBINSTALL, COQDOCINSTALL: - specify where the Coq libraries and documentation will be installed. + specify where the |Coq| libraries and documentation will be installed. By default a combination of ``$(DESTDIR)`` (if defined) with ``$(COQLIB)/user-contrib`` and ``$(DOCDIR)/user-contrib``. @@ -560,22 +560,22 @@ Building a |Coq| project with Dune .. note:: - Dune's Coq support is still experimental; we strongly recommend + Dune's |Coq| support is still experimental; we strongly recommend using Dune 2.3 or later. .. note:: - The canonical documentation for the Coq Dune extension is + The canonical documentation for the |Coq| Dune extension is maintained upstream; please refer to the `Dune manual <https://dune.readthedocs.io/>`_ for up-to-date information. This documentation is up to date for Dune 2.3. -Building a Coq project with Dune requires setting up a Dune project +Building a |Coq| project with Dune requires setting up a Dune project for your files. This involves adding a ``dune-project`` and ``pkg.opam`` file to the root (``pkg.opam`` can be empty or generated by Dune itself), and then providing ``dune`` files in the directories your ``.v`` files are placed. For the experimental version "0.1" of -the Coq Dune language, |Coq| library stanzas look like: +the |Coq| Dune language, |Coq| library stanzas look like: .. code:: scheme @@ -592,12 +592,12 @@ the library under ``<module_prefix>``. If you declare an ``<opam_package>``, an ``.install`` file for the library will be generated; the optional ``(modules <ordered_set_lang>)`` field allows you to filter the list of modules, and ``(libraries -<ocaml_libraries>)`` allows the Coq theory depend on ML plugins. For -the moment, Dune relies on Coq's standard mechanisms (such as -``COQPATH``) to locate installed Coq libraries. +<ocaml_libraries>)`` allows the |Coq| theory depend on ML plugins. For +the moment, Dune relies on |Coq|'s standard mechanisms (such as +``COQPATH``) to locate installed |Coq| libraries. By default Dune will skip ``.v`` files present in subdirectories. In -order to enable the usual recursive organization of Coq projects add +order to enable the usual recursive organization of |Coq| projects add .. code:: scheme @@ -611,7 +611,7 @@ of your project. .. example:: - A typical stanza for a Coq plugin is split into two parts. An OCaml build directive, which is standard Dune: + A typical stanza for a |Coq| plugin is split into two parts. An |OCaml| build directive, which is standard Dune: .. code:: scheme @@ -623,7 +623,7 @@ of your project. (coq.pp (modules g_equations)) - And a Coq-specific part that depends on it via the ``libraries`` field: + And a |Coq|-specific part that depends on it via the ``libraries`` field: .. code:: scheme @@ -656,10 +656,10 @@ command ``Declare ML Module``. See the man page of ``coqdep`` for more details and options. Both Dune and ``coq_makefile`` use ``coqdep`` to compute the -dependencies among the files part of a Coq project. +dependencies among the files part of a |Coq| project. -Embedded Coq phrases inside |Latex| documents ---------------------------------------------- +Embedded |Coq| phrases inside |Latex| documents +----------------------------------------------- When writing documentation about a proof development, one may want to insert |Coq| phrases inside a |Latex| document, possibly together @@ -670,7 +670,7 @@ evaluates them, and insert the outcome of the evaluation after each phrase. Starting with a file ``file.tex`` containing |Coq| phrases, the ``coq-tex`` -filter produces a file named ``file.v.tex`` with the Coq outcome. +filter produces a file named ``file.v.tex`` with the |Coq| outcome. There are options to produce the |Coq| parts in smaller font, italic, between horizontal rules, etc. See the man page of ``coq-tex`` for more diff --git a/doc/sphinx/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst index f18569c7fd..5c091f04ac 100644 --- a/doc/sphinx/proof-engine/ltac.rst +++ b/doc/sphinx/proof-engine/ltac.rst @@ -8,7 +8,7 @@ This chapter documents the tactic language |Ltac|. We start by giving the syntax followed by the informal semantics. To learn more about the language and especially about its foundations, please refer to :cite:`Del00`. -(Note the examples in the paper won't work as-is; Coq has evolved +(Note the examples in the paper won't work as-is; |Coq| has evolved since the paper was written.) .. example:: Basic tactic macros @@ -41,7 +41,7 @@ higher precedence than `+`. Usually `a/b/c` is given the :gdef:`left associativ interpretation `(a/b)/c` rather than the :gdef:`right associative` interpretation `a/(b/c)`. -In Coq, the expression :n:`try repeat @tactic__1 || @tactic__2; @tactic__3; @tactic__4` +In |Coq|, the expression :n:`try repeat @tactic__1 || @tactic__2; @tactic__3; @tactic__4` is interpreted as :n:`(try (repeat (@tactic__1 || @tactic__2)); @tactic__3); @tactic__4` because `||` is part of :token:`ltac_expr2`, which has higher precedence than :tacn:`try` and :tacn:`repeat` (at the level of :token:`ltac_expr3`), which @@ -784,7 +784,7 @@ single success: Checking for a single success: exactly_once ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Coq provides an experimental way to check that a tactic has *exactly +|Coq| provides an experimental way to check that a tactic has *exactly one* success: .. tacn:: exactly_once @ltac_expr3 @@ -813,7 +813,7 @@ one* success: Checking for failure: assert_fails ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Coq defines an |Ltac| tactic in `Init.Tactics` to check that a tactic *fails*: +|Coq| defines an |Ltac| tactic in `Init.Tactics` to check that a tactic *fails*: .. tacn:: assert_fails @ltac_expr3 :name: assert_fails @@ -859,7 +859,7 @@ Coq defines an |Ltac| tactic in `Init.Tactics` to check that a tactic *fails*: Checking for success: assert_succeeds ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Coq defines an |Ltac| tactic in `Init.Tactics` to check that a tactic has *at least one* +|Coq| defines an |Ltac| tactic in `Init.Tactics` to check that a tactic has *at least one* success: .. tacn:: assert_succeeds @ltac_expr3 @@ -879,7 +879,8 @@ Print/identity tactic: idtac .. tacn:: idtac {* {| @ident | @string | @natural } } :name: idtac - Leaves the proof unchanged and prints the given tokens. Strings and integers are printed + Leaves the proof unchanged and prints the given tokens. :token:`String<string>`\s + and :token:`natural`\s are printed literally. If :token:`ident` is an |Ltac| variable, its contents are printed; if not, it is an error. @@ -888,7 +889,7 @@ Print/identity tactic: idtac Failing ~~~~~~~ -.. tacn:: {| fail | gfail } {? @int_or_var } {* {| @ident | @string | @integer } } +.. tacn:: {| fail | gfail } {? @int_or_var } {* {| @ident | @string | @natural } } :name: fail; gfail :tacn:`fail` is the always-failing tactic: it does not solve any @@ -904,7 +905,7 @@ Failing See the example for a comparison of the two constructs. - Note that if Coq terms have to be + Note that if |Coq| terms have to be printed as part of the failure, term construction always forces the tactic into the goals, meaning that if there are no goals when it is evaluated, a tactic call like :tacn:`let` :n:`x := H in` :tacn:`fail` `0 x` will succeed. @@ -919,7 +920,7 @@ Failing the call to :tacn:`fail` :n:`@natural` is not enclosed in a :n:`+` construct, respecting the algebraic identity. - :n:`{* {| @ident | @string | @integer } }` + :n:`{* {| @ident | @string | @natural } }` The given tokens are used for printing the failure message. If :token:`ident` is an |Ltac| variable, its contents are printed; if not, it is an error. @@ -937,7 +938,7 @@ Failing .. todo the example is too long; could show the Goal True. Proof. once and hide the Aborts to shorten it. And add a line of text before each subexample. Perhaps add some very short - explanations/generalizations (eg gfail always fails; "tac; fail" succeeds but "fail." alone + explanations/generalizations (e.g. gfail always fails; "tac; fail" succeeds but "fail." alone fails. .. coqtop:: reset all fail @@ -989,7 +990,7 @@ amount of time: timeout with some other tacticals. This tactical is hence proposed only for convenience during debugging or other development phases, we strongly advise you to not leave any timeout in final scripts. Note also that - this tactical isn’t available on the native Windows port of Coq. + this tactical isn’t available on the native Windows port of |Coq|. Timing a tactic ~~~~~~~~~~~~~~~ @@ -1488,7 +1489,7 @@ Examples: match_context_rule ::= [ {*, @match_hyp } |- @match_pattern ] => @ltac_expr match_hyp ::= | @name := {? [ @match_pattern ] : } @match_pattern -.. todo PR The following items (up to numgoals) are part of "value_tactic". I'd like to make +.. todo The following items (up to numgoals) are part of "value_tactic". I'd like to make this a subsection and explain that they all return values. How do I get a 5th-level section title? Filling a term context @@ -1884,7 +1885,7 @@ Proving that a list is a permutation of a second list From Section :ref:`ltac-syntax` we know that Ltac has a primitive notion of integers, but they are only used as arguments for primitive tactics and we cannot make computations with them. Thus, - instead, we use Coq's natural number type :g:`nat`. + instead, we use |Coq|'s natural number type :g:`nat`. .. coqtop:: in diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst index 773e393eb6..64fc1133f0 100644 --- a/doc/sphinx/proof-engine/ltac2.rst +++ b/doc/sphinx/proof-engine/ltac2.rst @@ -3,8 +3,8 @@ Ltac2 ===== -The Ltac tactic language is probably one of the ingredients of the success of -Coq, yet it is at the same time its Achilles' heel. Indeed, Ltac: +The |Ltac| tactic language is probably one of the ingredients of the success of +|Coq|, yet it is at the same time its Achilles' heel. Indeed, |Ltac|: - has often unclear semantics - is very non-uniform due to organic growth @@ -30,7 +30,7 @@ as Ltac1. Current limitations include: - There are a number of tactics that are not yet supported in Ltac2 because - the interface OCaml and/or Ltac2 notations haven't been written. See + the interface |OCaml| and/or Ltac2 notations haven't been written. See :ref:`defining_tactics`. - Missing usability features such as: @@ -90,7 +90,7 @@ In particular, Ltac2 is: * together with the Hindley-Milner type system - a language featuring meta-programming facilities for the manipulation of - Coq-side terms + |Coq|-side terms - a language featuring notation facilities to help write palatable scripts We describe these in more detail in the remainder of this document. @@ -108,14 +108,14 @@ that ML constitutes a sweet spot in PL design, as it is relatively expressive while not being either too lax (unlike dynamic typing) nor too strict (unlike, say, dependent types). -The main goal of Ltac2 is to serve as a meta-language for Coq. As such, it +The main goal of Ltac2 is to serve as a meta-language for |Coq|. As such, it naturally fits in the ML lineage, just as the historical ML was designed as the tactic language for the LCF prover. It can also be seen as a general-purpose -language, by simply forgetting about the Coq-specific features. +language, by simply forgetting about the |Coq|-specific features. Sticking to a standard ML type system can be considered somewhat weak for a -meta-language designed to manipulate Coq terms. In particular, there is no -way to statically guarantee that a Coq term resulting from an Ltac2 +meta-language designed to manipulate |Coq| terms. In particular, there is no +way to statically guarantee that a |Coq| term resulting from an Ltac2 computation will be well-typed. This is actually a design choice, motivated by backward compatibility with Ltac1. Instead, well-typedness is deferred to dynamic checks, allowing many primitive functions to fail whenever they are @@ -138,7 +138,7 @@ Type Syntax ~~~~~~~~~~~ At the level of terms, we simply elaborate on Ltac1 syntax, which is quite -close to OCaml. Types follow the simply-typed syntax of OCaml. +close to |OCaml|. Types follow the simply-typed syntax of |OCaml|. .. insertprodn ltac2_type ltac2_typevar @@ -160,7 +160,7 @@ declarations such as algebraic datatypes and records. Built-in types include: -- ``int``, machine integers (size not specified, in practice inherited from OCaml) +- ``int``, machine integers (size not specified, in practice inherited from |OCaml|) - ``string``, mutable strings - ``'a array``, mutable arrays - ``exn``, exceptions @@ -201,7 +201,7 @@ One can define new types with the following commands. :token:`tac2typ_knd` should be in the form :n:`[ {? {? %| } {+| @tac2alg_constructor } } ]`. Without :n:`{| := | ::= }` - Defines an abstract type for use representing data from OCaml. Not for + Defines an abstract type for use representing data from |OCaml|. Not for end users. :n:`with @tac2typ_def` @@ -227,9 +227,9 @@ One can define new types with the following commands. .. cmd:: Ltac2 @ external @ident : @ltac2_type := @string @string :name: Ltac2 external - Declares abstract terms. Frequently, these declare OCaml functions + Declares abstract terms. Frequently, these declare |OCaml| functions defined in |Coq| and give their type information. They can also declare - data structures from OCaml. This command has no use for the end user. + data structures from |OCaml|. This command has no use for the end user. APIs ~~~~ @@ -363,7 +363,7 @@ Reduction ~~~~~~~~~ We use the usual ML call-by-value reduction, with an otherwise unspecified -evaluation order. This is a design choice making it compatible with OCaml, +evaluation order. This is a design choice making it compatible with |OCaml|, if ever we implement native compilation. The expected equations are as follows:: (fun x => t) V ≡ t{x := V} (βv) @@ -407,7 +407,7 @@ standard IO monad as the ambient effectful world, Ltac2 is has a tactic monad. Note that the order of evaluation of application is *not* specified and is -implementation-dependent, as in OCaml. +implementation-dependent, as in |OCaml|. We recall that the `Proofview.tactic` monad is essentially a IO monad together with backtracking state representing the proof state. @@ -537,8 +537,8 @@ aware of bound variables and must use heuristics to decide whether a variable is a proper one or referring to something in the Ltac context. Likewise, in Ltac1, constr parsing is implicit, so that ``foo 0`` is -not ``foo`` applied to the Ltac integer expression ``0`` (Ltac does have a -notion of integers, though it is not first-class), but rather the Coq term +not ``foo`` applied to the Ltac integer expression ``0`` (|Ltac| does have a +notion of integers, though it is not first-class), but rather the |Coq| term :g:`Datatypes.O`. The implicit parsing is confusing to users and often gives unexpected results. @@ -570,11 +570,11 @@ Built-in quotations The current implementation recognizes the following built-in quotations: - ``ident``, which parses identifiers (type ``Init.ident``). -- ``constr``, which parses Coq terms and produces an-evar free term at runtime +- ``constr``, which parses |Coq| terms and produces an-evar free term at runtime (type ``Init.constr``). -- ``open_constr``, which parses Coq terms and produces a term potentially with +- ``open_constr``, which parses |Coq| terms and produces a term potentially with holes at runtime (type ``Init.constr`` as well). -- ``pattern``, which parses Coq patterns and produces a pattern used for term +- ``pattern``, which parses |Coq| patterns and produces a pattern used for term matching (type ``Init.pattern``). - ``reference`` Qualified names are globalized at internalization into the corresponding global reference, @@ -617,7 +617,7 @@ Term Antiquotations Syntax ++++++ -One can also insert Ltac2 code into Coq terms, similar to what is possible in +One can also insert Ltac2 code into |Coq| terms, similar to what is possible in Ltac1. .. prodn:: @@ -629,7 +629,7 @@ for their side-effects. Semantics +++++++++ -A quoted Coq term is interpreted in two phases, internalization and +A quoted |Coq| term is interpreted in two phases, internalization and evaluation. - Internalization is part of the static semantics, that is, it is done at Ltac2 @@ -637,17 +637,17 @@ evaluation. - Evaluation is part of the dynamic semantics, that is, it is done when a term gets effectively computed by Ltac2. -Note that typing of Coq terms is a *dynamic* process occurring at Ltac2 +Note that typing of |Coq| terms is a *dynamic* process occurring at Ltac2 evaluation time, and not at Ltac2 typing time. Static semantics **************** -During internalization, Coq variables are resolved and antiquotations are -type checked as Ltac2 terms, effectively producing a ``glob_constr`` in Coq +During internalization, |Coq| variables are resolved and antiquotations are +type checked as Ltac2 terms, effectively producing a ``glob_constr`` in |Coq| implementation terminology. Note that although it went through the type checking of **Ltac2**, the resulting term has not been fully computed and -is potentially ill-typed as a runtime **Coq** term. +is potentially ill-typed as a runtime **|Coq|** term. .. example:: @@ -669,7 +669,7 @@ of the corresponding term expression. let x := '0 in constr:(1 + ltac2:(exact x)) Beware that the typing environment of antiquotations is **not** -expanded by the Coq binders from the term. +expanded by the |Coq| binders from the term. .. example:: @@ -692,17 +692,17 @@ as follows. `constr:(fun x : nat => ltac2:(exact (hyp @x)))` -This pattern is so common that we provide dedicated Ltac2 and Coq term notations +This pattern is so common that we provide dedicated Ltac2 and |Coq| term notations for it. - `&x` as an Ltac2 expression expands to `hyp @x`. -- `&x` as a Coq constr expression expands to +- `&x` as a |Coq| constr expression expands to `ltac2:(Control.refine (fun () => hyp @x))`. -In the special case where Ltac2 antiquotations appear inside a Coq term +In the special case where Ltac2 antiquotations appear inside a |Coq| term notation, the notation variables are systematically bound in the body of the tactic expression with type `Ltac2.Init.preterm`. Such a type represents -untyped syntactic Coq expressions, which can by typed in the +untyped syntactic |Coq| expressions, which can by typed in the current context using the `Ltac2.Constr.pretype` function. .. example:: @@ -748,9 +748,9 @@ the notation section. .. prodn:: term += $@lident -In a Coq term, writing :g:`$x` is semantically equivalent to +In a |Coq| term, writing :g:`$x` is semantically equivalent to :g:`ltac2:(Control.refine (fun () => x))`, up to re-typechecking. It allows to -insert in a concise way an Ltac2 variable of type :n:`constr` into a Coq term. +insert in a concise way an Ltac2 variable of type :n:`constr` into a |Coq| term. Match over terms ~~~~~~~~~~~~~~~~ @@ -1129,7 +1129,7 @@ Match on values .. tacn:: match @ltac2_expr5 with {? @ltac2_branches } end :name: match (Ltac2) - Matches a value, akin to the OCaml `match` construct. By itself, it doesn't cause backtracking + Matches a value, akin to the |OCaml| `match` construct. By itself, it doesn't cause backtracking as do the `*match*!` and `*match*! goal` constructs. .. insertprodn ltac2_branches atomic_tac2pat @@ -1254,7 +1254,7 @@ Abbreviations Introduces a special kind of notation, called an abbreviation, that does not add any parsing rules. It is similar in - spirit to Coq abbreviations (see :cmd:`Notation (abbreviation)`, + spirit to |Coq| abbreviations (see :cmd:`Notation (abbreviation)`, insofar as its main purpose is to give an absolute name to a piece of pure syntax, which can be transparently referred to by this name as if it were a proper definition. @@ -1281,7 +1281,7 @@ Abbreviations Defining tactics ~~~~~~~~~~~~~~~~ -Built-in tactics (those defined in OCaml code in the |Coq| executable) and Ltac1 tactics, +Built-in tactics (those defined in |OCaml| code in the |Coq| executable) and Ltac1 tactics, which are defined in `.v` files, must be defined through notations. (Ltac2 tactics can be defined with :cmd:`Ltac2`. @@ -1795,7 +1795,7 @@ Transition from Ltac1 Owing to the use of a lot of notations, the transition should not be too difficult. In particular, it should be possible to do it incrementally. That said, we do *not* guarantee it will be a blissful walk either. -Hopefully, owing to the fact Ltac2 is typed, the interactive dialogue with Coq +Hopefully, owing to the fact Ltac2 is typed, the interactive dialogue with |Coq| will help you. We list the major changes and the transition strategies hereafter. diff --git a/doc/sphinx/proof-engine/proof-handling.rst b/doc/sphinx/proof-engine/proof-handling.rst index f90ebadb3a..b09d6146d8 100644 --- a/doc/sphinx/proof-engine/proof-handling.rst +++ b/doc/sphinx/proof-engine/proof-handling.rst @@ -11,7 +11,7 @@ section. They can also use some other specialized commands called *tactics*. They are the very tools allowing the user to deal with logical reasoning. They are documented in Chapter :ref:`tactics`. -Coq user interfaces usually have a way of marking whether the user has +|Coq| user interfaces usually have a way of marking whether the user has switched to proof editing mode. For instance, in coqtop the prompt ``Coq <`` is changed into :n:`@ident <` where :token:`ident` is the declared name of the theorem currently edited. @@ -36,7 +36,7 @@ terms are called *proof terms*. .. exn:: No focused proof. - Coq raises this error message when one attempts to use a proof editing command + |Coq| raises this error message when one attempts to use a proof editing command out of the proof editing mode. .. _proof-editing-mode: @@ -49,7 +49,7 @@ the assertion of a theorem using an assertion command like :cmd:`Theorem`. The list of assertion commands is given in :ref:`Assertions`. The command :cmd:`Goal` can also be used. -.. cmd:: Goal @form +.. cmd:: Goal @type This is intended for quick assertion of statements, without knowing in advance which name to give to the assertion, typically for quick @@ -62,8 +62,8 @@ list of assertion commands is given in :ref:`Assertions`. The command This command is available in interactive editing proof mode when the proof is completed. Then :cmd:`Qed` extracts a proof term from the proof - script, switches back to Coq top-level and attaches the extracted - proof term to the declared name of the original goal. This name is + script, switches back to |Coq| top-level and attaches the extracted + proof term to the declared name of the original goal. The name is added to the environment as an opaque constant. .. exn:: Attempt to save an incomplete proof. @@ -80,42 +80,42 @@ list of assertion commands is given in :ref:`Assertions`. The command a while when the proof is large. In some exceptional cases one may even incur a memory overflow. -.. cmd:: Defined - - Same as :cmd:`Qed`, except the proof is made *transparent*, which means - 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`). - .. cmd:: Save @ident :name: Save - Saves a completed proof with the name :token:`ident`. + Saves a completed proof with the name :token:`ident`, which + overrides any name provided by the :cmd:`Theorem` command or + its variants. + +.. cmd:: Defined {? @ident } + + Similar to :cmd:`Qed` and :cmd:`Save`, except the proof is made *transparent*, which means + 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`). If :token:`ident` is specified, + the proof is defined with the given name, which overrides any name + provided by the :cmd:`Theorem` command or its variants. .. cmd:: Admitted This command is available in interactive editing mode to give up the current proof and declare the initial goal as an axiom. -.. cmd:: Abort +.. cmd:: Abort {? {| All | @ident } } - This command cancels the current proof development, switching back to + Cancels the current proof development, switching back to the previous proof development, or to the |Coq| toplevel if no other - proof was edited. - - .. exn:: No focused proof (No proof-editing in progress). - :undocumented: - - .. cmdv:: Abort @ident + proof was being edited. - Aborts the editing of the proof named :token:`ident` (in case you have - nested proofs). + :n:`@ident` + Aborts editing the proof named :n:`@ident` for use when you have + nested proofs. See also :flag:`Nested Proofs Allowed`. - .. seealso:: :flag:`Nested Proofs Allowed` + :n:`All` + Aborts all current proofs. - .. cmdv:: Abort All - - Aborts all current goals. + .. exn:: No focused proof (No proof-editing in progress). + :undocumented: .. cmd:: Proof @term :name: Proof `term` @@ -143,12 +143,26 @@ list of assertion commands is given in :ref:`Assertions`. The command .. seealso:: :cmd:`Proof with` -.. cmd:: Proof using {+ @ident } +.. cmd:: Proof using @section_var_expr {? with @ltac_expr } + + .. insertprodn section_var_expr starred_ident_ref - This command applies in proof editing mode. It declares the set of + .. prodn:: + section_var_expr ::= {* @starred_ident_ref } + | {? - } @section_var_expr50 + section_var_expr50 ::= @section_var_expr0 - @section_var_expr0 + | @section_var_expr0 + @section_var_expr0 + | @section_var_expr0 + section_var_expr0 ::= @starred_ident_ref + | ( @section_var_expr ) {? * } + starred_ident_ref ::= @ident {? * } + | Type {? * } + | All + + Opens proof editing mode, declaring the set of section variables (see :ref:`gallina-assumptions`) used by the proof. At :cmd:`Qed` time, the - system will assert that the set of section variables actually used in + system verifies that the set of section variables used in the proof is a subset of the declared one. The set of declared variables is closed under type dependency. For @@ -160,51 +174,30 @@ list of assertion commands is given in :ref:`Assertions`. The command the statement. In other words ``Proof using e`` is equivalent to ``Proof using Type + e`` for any declaration expression ``e``. - .. cmdv:: Proof using {+ @ident } with @tactic - - Combines in a single line :cmd:`Proof with` and :cmd:`Proof using`. + :n:`- @section_var_expr50` + Use all section variables except those specified by :n:`@section_var_expr50` - .. seealso:: :ref:`tactics-implicit-automation` + :n:`@section_var_expr0 + @section_var_expr0` + Use section variables from the union of both collections. + See :ref:`nameaset` to see how to form a named collection. - .. cmdv:: Proof using All + :n:`@section_var_expr0 - @section_var_expr0` + Use section variables which are in the first collection but not in the + second one. - Use all section variables. + :n:`{? * }` + Use the transitive closure of the specified collection. - .. cmdv:: Proof using {? Type } + :n:`Type` + Use only section variables occurring in the statement. Specifying :n:`*` + uses the forward transitive closure of all the section variables occurring + in the statement. For example, if the variable ``H`` has type ``p < 5`` then + ``H`` is in ``p*`` since ``p`` occurs in the type of ``H``. - Use only section variables occurring in the statement. - - .. cmdv:: Proof using Type* - - The ``*`` operator computes the forward transitive closure. E.g. if the - variable ``H`` has type ``p < 5`` then ``H`` is in ``p*`` since ``p`` occurs in the type - of ``H``. ``Type*`` is the forward transitive closure of the entire set of - section variables occurring in the statement. - - .. cmdv:: Proof using -({+ @ident }) - - Use all section variables except the list of :token:`ident`. - - .. cmdv:: Proof using @collection__1 + @collection__2 - - Use section variables from the union of both collections. - See :ref:`nameaset` to know how to form a named collection. - - .. cmdv:: Proof using @collection__1 - @collection__2 - - Use section variables which are in the first collection but not in the - second one. - - .. cmdv:: Proof using @collection - ({+ @ident }) - - Use section variables which are in the first collection but not in the - list of :token:`ident`. - - .. cmdv:: Proof using @collection * - - Use section variables in the forward transitive closure of the collection. - The ``*`` operator binds stronger than ``+`` and ``-``. + :n:`All` + Use all section variables. + .. seealso:: :ref:`tactics-implicit-automation` Proof using options ``````````````````` @@ -212,10 +205,10 @@ Proof using options The following options modify the behavior of ``Proof using``. -.. opt:: Default Proof Using "@collection" +.. opt:: Default Proof Using "@section_var_expr" :name: Default Proof Using - Use :n:`@collection` as the default ``Proof using`` value. E.g. ``Set Default + Use :n:`@section_var_expr` as the default ``Proof using`` value. E.g. ``Set Default Proof Using "a b"`` will complete all ``Proof`` commands not followed by a ``using`` part with ``using a b``. @@ -230,7 +223,7 @@ The following options modify the behavior of ``Proof using``. Name a set of section hypotheses for ``Proof using`` ```````````````````````````````````````````````````` -.. cmd:: Collection @ident := @collection +.. cmd:: Collection @ident := @section_var_expr This can be used to name a set of section hypotheses, with the purpose of making ``Proof using`` annotations more @@ -259,7 +252,7 @@ Name a set of section hypotheses for ``Proof using`` -.. cmd:: Existential @natural := @term +.. cmd:: Existential @natural {? : @type } := @term This command instantiates an existential variable. :token:`natural` is an index in the list of uninstantiated existential variables displayed by :cmd:`Show Existentials`. @@ -285,64 +278,60 @@ their own proof modes. The default proof mode used when opening a proof can be changed using the following option. .. opt:: Default Proof Mode @string - :name: Default Proof Mode Select the proof mode to use when starting a proof. Depending on the proof mode, various syntactic constructs are allowed when writing an interactive - proof. The possible option values are listed below. - - - "Classic": this is the default. It activates the |Ltac| language to interact - with the proof, and also allows vernacular commands. - - - "Noedit": this proof mode only allows vernacular commands. No tactic - language is activated at all. This is the default when the prelude is not - loaded, e.g. through the `-noinit` option for `coqc`. - - - "Ltac2": this proof mode is made available when requiring the Ltac2 - library, and is set to be the default when it is imported. It allows - to use the Ltac2 language, as well as vernacular commands. - - - Some external plugins also define their own proof mode, which can be - activated via this command. + proof. All proof modes support vernacular commands; the proof mode determines + which tactic language and set of tactic definitions are available. The + possible option values are: + + `"Classic"` + Activates the |Ltac| language and the tactics with the syntax documented + in this manual. + Some tactics are not available until the associated plugin is loaded, + such as `SSR` or `micromega`. + This proof mode is set when the :term:`prelude` is loaded. + + `"Noedit"` + No tactic + language is activated at all. This is the default when the :term:`prelude` + is not loaded, e.g. through the `-noinit` option for `coqc`. + + `"Ltac2"` + Activates the Ltac2 language and the Ltac2-specific variants of the documented + tactics. + This value is only available after :cmd:`Requiring <Require>` Ltac2. + :cmd:`Importing <Import>` Ltac2 sets this mode. + + Some external plugins also define their own proof mode, which can be + activated with this command. Navigation in the proof tree -------------------------------- -.. cmd:: Undo - - This command cancels the effect of the last command. Thus, it - backtracks one step. +.. cmd:: Undo {? {? To } @natural } -.. cmdv:: Undo @natural + Cancels the effect of the last :token:`natural` commands or tactics. + The :n:`To @natural` form goes back to the specified state number. + If :token:`natural` is not specified, the command goes back one command or tactic. - Repeats Undo :token:`natural` times. +.. cmd:: Restart -.. cmdv:: Restart - :name: Restart - - This command restores the proof editing process to the original goal. + Restores the proof editing process to the original goal. .. exn:: No focused proof to restart. :undocumented: -.. cmd:: Focus +.. cmd:: Focus {? @natural } - This focuses the attention on the first subgoal to prove and the + Focuses the attention on the first subgoal to prove or, if :token:`natural` is + specified, the :token:`natural`\-th. The printing of the other subgoals is suspended until the focused subgoal - is solved or unfocused. This is useful when there are many current - subgoals which clutter your screen. + is solved or unfocused. .. deprecated:: 8.8 - Prefer the use of bullets or focusing brackets (see below). - -.. cmdv:: Focus @natural - - This focuses the attention on the :token:`natural` th subgoal to prove. - - .. deprecated:: 8.8 - - Prefer the use of focusing brackets with a goal selector (see below). + Prefer the use of bullets or focusing brackets with a goal selector (see below). .. cmd:: Unfocus @@ -361,11 +350,19 @@ Navigation in the proof tree .. index:: { } -.. cmd:: {| %{ | %} } +.. todo: :name: "{"; "}" doesn't work, nor does :name: left curly bracket; right curly bracket, + hence the verbose names + +.. tacn:: {? {| @natural | [ @ident ] } : } %{ + %} - The command ``{`` (without a terminating period) focuses on the first - goal, much like :cmd:`Focus` does, however, the subproof can only be - unfocused when it has been fully solved ( *i.e.* when there is no + .. todo + See https://github.com/coq/coq/issues/12004 and + https://github.com/coq/coq/issues/12825. + + ``{`` (without a terminating period) focuses on the first + goal. The subproof can only be + unfocused when it has been fully solved (*i.e.*, when there is no focused goal left). Unfocusing is then handled by ``}`` (again, without a terminating period). See also an example in the next section. @@ -373,67 +370,65 @@ Navigation in the proof tree together with a suggestion about the right bullet or ``}`` to unfocus it or focus the next one. - .. cmdv:: @natural: %{ - - This focuses on the :token:`natural`\-th subgoal to prove. + :n:`@natural:` + Focuses on the :token:`natural`\-th subgoal to prove. - .. cmdv:: [@ident]: %{ + :n:`[ @ident ]: %{` + Focuses on the named goal :token:`ident`. - This focuses on the named goal :token:`ident`. - - .. note:: + .. note:: - Goals are just existential variables and existential variables do not - get a name by default. You can give a name to a goal by using :n:`refine ?[@ident]`. - You may also wrap this in an Ltac-definition like: + Goals are just existential variables and existential variables do not + get a name by default. You can give a name to a goal by using :n:`refine ?[@ident]`. + You may also wrap this in an Ltac-definition like: - .. coqtop:: in + .. coqtop:: in - Ltac name_goal name := refine ?[name]. + Ltac name_goal name := refine ?[name]. - .. seealso:: :ref:`existential-variables` + .. seealso:: :ref:`existential-variables` - .. example:: + .. example:: - This first example uses the Ltac definition above, and the named goals - only serve for documentation. + This first example uses the Ltac definition above, and the named goals + only serve for documentation. - .. coqtop:: all + .. coqtop:: all - Goal forall n, n + 0 = n. - Proof. - induction n; [ name_goal base | name_goal step ]. - [base]: { + Goal forall n, n + 0 = n. + Proof. + induction n; [ name_goal base | name_goal step ]. + [base]: { - .. coqtop:: all + .. coqtop:: all - reflexivity. + reflexivity. - .. coqtop:: in + .. coqtop:: in - } + } - .. coqtop:: all + .. coqtop:: all - [step]: { + [step]: { - .. coqtop:: all + .. coqtop:: all - simpl. - f_equal. - assumption. - } - Qed. + simpl. + f_equal. + assumption. + } + Qed. - This can also be a way of focusing on a shelved goal, for instance: + This can also be a way of focusing on a shelved goal, for instance: - .. coqtop:: all + .. coqtop:: all - Goal exists n : nat, n = n. - eexists ?[x]. - reflexivity. - [x]: exact 0. - Qed. + Goal exists n : nat, n = n. + eexists ?[x]. + reflexivity. + [x]: exact 0. + Qed. .. exn:: This proof is focused, but cannot be unfocused this way. @@ -450,14 +445,14 @@ 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 for bullets below. .. _bullets: Bullets ``````` -Alternatively to ``{`` and ``}``, proofs can be structured with bullets. The +Alternatively, proofs can be structured with bullets instead of ``{`` and ``}``. The use of a bullet ``b`` for the first time focuses on the first goal ``g``, the same bullet cannot be used again until the proof of ``g`` is completed, then it is mandatory to focus the next goal with ``b``. The consequence is @@ -552,111 +547,103 @@ Requesting information ---------------------- -.. cmd:: Show - - This command displays the current goals. +.. cmd:: Show {? {| @ident | @natural } } - .. exn:: No focused proof. - :undocumented: + Displays the current goals. - .. cmdv:: Show @natural + :n:`@natural` + Display only the :token:`natural`\-th subgoal. - Displays only the :token:`natural`\-th subgoal. + :n:`@ident` + Displays the named goal :token:`ident`. This is useful in + particular to display a shelved goal but only works if the + corresponding existential variable has been named by the user + (see :ref:`existential-variables`) as in the following example. - .. exn:: No such goal. - :undocumented: + .. example:: - .. cmdv:: Show @ident + .. coqtop:: all abort - Displays the named goal :token:`ident`. This is useful in - particular to display a shelved goal but only works if the - corresponding existential variable has been named by the user - (see :ref:`existential-variables`) as in the following example. + Goal exists n, n = 0. + eexists ?[n]. + Show n. - .. example:: - - .. coqtop:: all abort + .. exn:: No focused proof. + :undocumented: - Goal exists n, n = 0. - eexists ?[n]. - Show n. + .. exn:: No such goal. + :undocumented: - .. cmdv:: Show Proof {? Diffs {? removed } } - :name: Show Proof +.. cmd:: Show Proof {? Diffs {? removed } } - Displays the proof term generated by the tactics - that have been applied so far. If the proof is incomplete, the term - will contain holes, which correspond to subterms which are still to be - constructed. Each hole is an existential variable, which appears as a - question mark followed by an identifier. + Displays the proof term generated by the tactics + that have been applied so far. If the proof is incomplete, the term + will contain holes, which correspond to subterms which are still to be + constructed. Each hole is an existential variable, which appears as a + question mark followed by an identifier. - Experimental: Specifying “Diffs” highlights the difference between the - current and previous proof step. By default, the command shows the - output once with additions highlighted. Including “removed” shows - the output twice: once showing removals and once showing additions. - It does not examine the :opt:`Diffs` option. See :ref:`showing_diffs`. + Specifying “Diffs” highlights the difference between the + current and previous proof step. By default, the command shows the + output once with additions highlighted. Including “removed” shows + the output twice: once showing removals and once showing additions. + It does not examine the :opt:`Diffs` option. See :ref:`showing_proof_diffs`. - .. cmdv:: Show Conjectures - :name: Show Conjectures +.. cmd:: Show Conjectures - It prints the list of the names of all the - theorems that are currently being proved. As it is possible to start - proving a previous lemma during the proof of a theorem, this list may - contain several names. + Prints the names of all the + theorems that are currently being proved. As it is possible to start + proving a previous lemma during the proof of a theorem, there may + be multiple names. - .. cmdv:: Show Intro - :name: Show Intro +.. cmd:: Show Intro - If the current goal begins by at least one product, - this command prints the name of the first product, as it would be - generated by an anonymous :tacn:`intro`. The aim of this command is to ease - the writing of more robust scripts. For example, with an appropriate - Proof General macro, it is possible to transform any anonymous :tacn:`intro` - into a qualified one such as ``intro y13``. In the case of a non-product - goal, it prints nothing. + If the current goal begins by at least one product, + prints the name of the first product as it would be + generated by an anonymous :tacn:`intro`. The aim of this command is to ease + the writing of more robust scripts. For example, with an appropriate + Proof General macro, it is possible to transform any anonymous :tacn:`intro` + into a qualified one such as ``intro y13``. In the case of a non-product + goal, it prints nothing. - .. cmdv:: Show Intros - :name: Show Intros +.. cmd:: Show Intros - This command is similar to the previous one, it - simulates the naming process of an :tacn:`intros`. + Similar to the previous command. + Simulates the naming process of :tacn:`intros`. - .. cmdv:: Show Existentials - :name: Show Existentials +.. cmd:: Show Existentials - Displays all open goals / existential variables in the current proof - along with the type and the context of each variable. + Displays all open goals / existential variables in the current proof + along with the type and the context of each variable. - .. cmdv:: Show Match @ident +.. cmd:: Show Match @qualid - This variant displays a template of the Gallina - ``match`` construct with a branch for each constructor of the type - :token:`ident` + Displays a template of the Gallina :token:`match<term_match>` + construct with a branch for each constructor of the type + :token:`qualid`. This is used internally by + `company-coq <https://github.com/cpitclaudel/company-coq>`_. - .. example:: + .. example:: - .. coqtop:: all + .. coqtop:: all - Show Match nat. + Show Match nat. - .. exn:: Unknown inductive type. - :undocumented: + .. exn:: Unknown inductive type. + :undocumented: - .. cmdv:: Show Universes - :name: Show Universes +.. cmd:: Show Universes - It displays the set of all universe constraints and - its normalized form at the current stage of the proof, useful for - debugging universe inconsistencies. + Displays the set of all universe constraints and + its normalized form at the current stage of the proof, useful for + debugging universe inconsistencies. - .. cmdv:: Show Goal @natural at @natural - :name: Show Goal +.. cmd:: Show Goal @natural at @natural - This command is only available in coqtop. Displays a goal at a - proof state using the goal ID number and the proof state ID number. - It is primarily for use by tools such as Prooftree that need to fetch - goal history in this way. Prooftree is a tool for visualizing a proof - as a tree that runs in Proof General. + Available in coqtop. Displays a goal at a + proof state using the goal ID number and the proof state ID number. + It is primarily for use by tools such as Prooftree that need to fetch + goal history in this way. Prooftree is a tool for visualizing a proof + as a tree that runs in Proof General. .. cmd:: Guarded @@ -675,13 +662,10 @@ Requesting information Showing differences between proof steps --------------------------------------- - -Coq can automatically highlight the differences between successive proof steps -and between values in some error messages. Also, as an experimental feature, -Coq can also highlight differences between proof steps shown in the :cmd:`Show Proof` -command, but only, for now, when using coqtop and Proof General. - -For example, the following screenshots of CoqIDE and coqtop show the application +|Coq| can automatically highlight the differences between successive proof steps +and between values in some error messages. |Coq| can also highlight differences +in the proof term. +For example, the following screenshots of |CoqIDE| and coqtop show the application of the same :tacn:`intros` tactic. The tactic creates two new hypotheses, highlighted in green. The conclusion is entirely in pale green because although it’s changed, no tokens were added to it. The second screenshot uses the "removed" option, so it shows the conclusion a @@ -717,7 +701,7 @@ new, no line of old text is shown for them. .. image:: ../_static/diffs-coqtop-on3.png :alt: coqtop with Set Diffs on -This image shows an error message with diff highlighting in CoqIDE: +This image shows an error message with diff highlighting in |CoqIDE|: .. @@ -738,21 +722,21 @@ How to enable diffs For coqtop, showing diffs can be enabled when starting coqtop with the ``-diffs on|off|removed`` command-line option or by setting the :opt:`Diffs` option -within Coq. You will need to provide the ``-color on|auto`` command-line option when +within |Coq|. You will need to provide the ``-color on|auto`` command-line option when you start coqtop in either case. Colors for coqtop can be configured by setting the ``COQ_COLORS`` environment variable. See section :ref:`customization-by-environment-variables`. Diffs use the tags ``diff.added``, ``diff.added.bg``, ``diff.removed`` and ``diff.removed.bg``. -In CoqIDE, diffs should be enabled from the ``View`` menu. Don’t use the ``Set Diffs`` -command in CoqIDE. You can change the background colors shown for diffs from the +In |CoqIDE|, diffs should be enabled from the ``View`` menu. Don’t use the ``Set Diffs`` +command in |CoqIDE|. You can change the background colors shown for diffs from the ``Edit | Preferences | Tags`` panel by changing the settings for the ``diff.added``, ``diff.added.bg``, ``diff.removed`` and ``diff.removed.bg`` tags. This panel also lets you control other attributes of the highlights, such as the foreground color, bold, italic, underline and strikeout. -As of June 2019, Proof General can also display Coq-generated proof diffs automatically. +Proof General can also display |Coq|-generated proof diffs automatically. Please see the PG documentation section "`Showing Proof Diffs" <https://proofgeneral.github.io/doc/master/userman/Coq-Proof-General#Showing-Proof-Diffs>`_) for details. @@ -826,14 +810,37 @@ the split because it has not changed. .. image:: ../_static/diffs-coqide-multigoal.png :alt: coqide with Set Diffs on with multiple goals -This is how diffs may appear after applying a :tacn:`intro` tactic that results -in compacted hypotheses: +Diffs may appear like this after applying a :tacn:`intro` tactic that results +in a compacted hypotheses: .. .. image:: ../_static/diffs-coqide-compacted.png :alt: coqide with Set Diffs on with compacted hypotheses +.. _showing_proof_diffs: + +"Show Proof" differences +```````````````````````` + +To show differences in the proof term: + +- In coqtop and Proof General, use the :cmd:`Show Proof` `Diffs` command. + +- In |CoqIDE|, position the cursor on or just after a tactic to compare the proof term + after the tactic with the proof term before the tactic, then select + `View / Show Proof` from the menu or enter the associated key binding. + Differences will be shown applying the current `Show Diffs` setting + from the `View` menu. If the current setting is `Don't show diffs`, diffs + will not be shown. + + Output with the "added and removed" option looks like this: + + .. + + .. image:: ../_static/diffs-show-proof.png + :alt: coqide with Set Diffs on with compacted hypotheses + Controlling the effect of proof editing commands ------------------------------------------------ @@ -852,12 +859,17 @@ Controlling the effect of proof editing commands When turned on (it is off by default), this flag enables support for nested proofs: a new assertion command can be inserted before the current proof is - finished, in which case Coq will temporarily switch to the proof of this + finished, in which case |Coq| will temporarily switch to the proof of this *nested lemma*. When the proof of the nested lemma is finished (with :cmd:`Qed` or :cmd:`Defined`), its statement will be made available (as if it had been - proved before starting the previous proof) and Coq will switch back to the + proved before starting the previous proof) and |Coq| will switch back to the proof of the previous assertion. +.. flag:: Printing Goal Names + + When turned on, the name of the goal is printed in interactive + proof mode, which can be useful in cases of cross references + between goals. Controlling memory usage ------------------------ @@ -867,7 +879,7 @@ Controlling memory usage Prints heap usage statistics, which are values from the `stat` type of the `Gc` module described `here <https://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#TYPEstat>`_ - in the OCaml documentation. + in the |OCaml| documentation. The `live_words`, `heap_words` and `top_heap_words` values give the basic information. Words are 8 bytes or 4 bytes, respectively, for 64- and 32-bit executables. @@ -882,7 +894,7 @@ to force |Coq| to optimize some of its internal data structures. .. cmd:: Optimize Heap Perform a heap compaction. This is generally an expensive operation. - See: `OCaml Gc.compact <http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALcompact>`_ + See: `|OCaml| Gc.compact <http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALcompact>`_ There is also an analogous tactic :tacn:`optimize_heap`. Memory usage parameters can be set through the :ref:`OCAMLRUNPARAM <OCAMLRUNPARAM>` diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst index ca50a02562..770de9a6c3 100644 --- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst +++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst @@ -158,23 +158,23 @@ compatible with the rest of |Coq|, up to a few discrepancies: generalized form, turn off the |SSR| Boolean ``if`` notation using the command: ``Close Scope boolean_if_scope``. + The following flags can be unset to make |SSR| more compatible with - parts of Coq: + parts of |Coq|: .. flag:: SsrRewrite Controls whether the incompatible rewrite syntax is enabled (the default). - Disabling the flag makes the syntax compatible with other parts of Coq. + Disabling the flag makes the syntax compatible with other parts of |Coq|. .. flag:: SsrIdents Controls whether tactics can refer to |SSR|-generated variables that are in the form _xxx_. Scripts with explicit references to such variables are fragile; they are prone to failure if the proof is later modified or - if the details of variable name generation change in future releases of Coq. + if the details of variable name generation change in future releases of |Coq|. The default is on, which gives an error message when the user tries to create such identifiers. Disabling the flag generates a warning instead, - increasing compatibility with other parts of Coq. + increasing compatibility with other parts of |Coq|. |Gallina| extensions -------------------- diff --git a/doc/sphinx/proof-engine/tactics.rst b/doc/sphinx/proof-engine/tactics.rst index 4b1f312105..fe9a31e220 100644 --- a/doc/sphinx/proof-engine/tactics.rst +++ b/doc/sphinx/proof-engine/tactics.rst @@ -86,42 +86,36 @@ specified, the default selector is used. Although other selectors are available, only ``all``, ``!`` or a single natural number are valid default goal selectors. -.. _bindingslist: +.. _bindings: -Bindings list -~~~~~~~~~~~~~ +Bindings +~~~~~~~~ -Tactics that take a term as an argument may also support a bindings list +Tactics that take a term as an argument may also accept :token:`bindings` to instantiate some parameters of the term by name or position. -The general form of a term with a bindings list is -:n:`@term with @bindings_list` where :token:`bindings_list` can take two different forms: +The general form of a term with :token:`bindings` is +:n:`@term__tac with @bindings` where :token:`bindings` can take two different forms: -.. _bindings_list_grammar: + .. insertprodn bindings bindings .. prodn:: - ref ::= @ident - | @natural - bindings_list ::= {+ (@ref := @term) } - | {+ @term } - -+ In a bindings list of the form :n:`{+ (@ref:= @term)}`, :n:`@ref` is either an - :n:`@ident` or a :n:`@natural`. The references are determined according to the type of - :n:`@term`. If :n:`@ref` is an identifier, this identifier has to be bound in the - type of :n:`@term` and the binding provides the tactic with an instance for the - parameter of this name. If :n:`@ref` is a number ``n``, it refers to - the ``n``-th non dependent premise of the :n:`@term`, as determined by the type - of :n:`@term`. + bindings ::= {+ ( {| @ident | @natural } := @term ) } + | {+ @one_term } + ++ In the first form, if an :token:`ident` is specified, it must be bound in the + type of :n:`@term` and provides the tactic with an instance for the + parameter of this name. If a :token:`natural` is specified, it refers to + the ``n``-th non dependent premise of :n:`@term__tac`. .. exn:: No such binder. :undocumented: -+ A bindings list can also be a simple list of terms :n:`{* @term}`. - In that case the references to which these terms correspond are - determined by the tactic. In case of :tacn:`induction`, :tacn:`destruct`, :tacn:`elim` - and :tacn:`case`, the terms have to - provide instances for all the dependent products in the type of term while in ++ In the second form, the interpretation of the :token:`one_term`\s depend on which + tactic they appear in. For :tacn:`induction`, :tacn:`destruct`, :tacn:`elim` + and :tacn:`case`, the :token:`one_term`\s + provide instances for all the dependent products in the type of :n:`@term__tac` while in the case of :tacn:`apply`, or of :tacn:`constructor` and its variants, only instances - for the dependent products that are not bound in the conclusion of the type + for the dependent products that are not bound in the conclusion of :n:`@term__tac` are required. .. exn:: Not the right number of missing arguments. @@ -173,11 +167,11 @@ The :n:`eqn:` construct in various tactics uses :n:`@naming_intropattern`. Use these elementary patterns to specify a name: * :n:`@ident` — use the specified name -* :n:`?` — let Coq choose a name +* :n:`?` — let |Coq| choose a name * :n:`?@ident` — generate a name that begins with :n:`@ident` * :n:`_` — discard the matched part (unless it is required for another hypothesis) -* if a disjunction pattern omits a name, such as :g:`[|H2]`, Coq will choose a name +* if a disjunction pattern omits a name, such as :g:`[|H2]`, |Coq| will choose a name **Splitting patterns** @@ -682,11 +676,11 @@ Applying theorems .. exn:: Not the right number of missing arguments. :undocumented: - .. tacv:: apply @term with @bindings_list + .. tacv:: apply @term with @bindings This also provides apply with values for instantiating premises. Here, variables are referred by names and non-dependent products by increasing numbers (see - :ref:`bindings list <bindingslist>`). + :ref:`bindings`). .. tacv:: apply {+, @term} @@ -747,8 +741,8 @@ Applying theorems tactics that backtrack often. Moreover, it does not traverse tuples as :tacn:`apply` does. - .. tacv:: {? simple} apply {+, @term {? with @bindings_list}} - {? simple} eapply {+, @term {? with @bindings_list}} + .. tacv:: {? simple} apply {+, @term {? with @bindings}} + {? simple} eapply {+, @term {? with @bindings}} :name: simple apply; simple eapply This summarizes the different syntaxes for :tacn:`apply` and :tacn:`eapply`. @@ -849,7 +843,7 @@ Applying theorems .. flag:: Universal Lemma Under Conjunction - This flag, which preserves compatibility with versions of Coq prior to + This flag, which preserves compatibility with versions of |Coq| prior to 8.4 is also available for :n:`apply @term in @ident` (see :tacn:`apply … in`). .. tacn:: apply @term in @ident @@ -888,18 +882,18 @@ Applying theorems This applies each :token:`term` in sequence in :token:`ident`. - .. tacv:: apply {+, @term with @bindings_list} in @ident + .. tacv:: apply {+, @term with @bindings} in @ident 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>`). + (see :ref:`bindings`). - .. tacv:: eapply {+, @term {? with @bindings_list } } in @ident + .. tacv:: eapply {+, @term {? with @bindings } } in @ident This works as :tacn:`apply … in` but turns unresolved bindings into existential variables, if any, instead of failing. - .. tacv:: apply {+, @term {? with @bindings_list } } in @ident as @simple_intropattern + .. tacv:: apply {+, @term {? with @bindings } } in @ident as @simple_intropattern :name: apply … in … as This works as :tacn:`apply … in` then applies the :token:`simple_intropattern` @@ -911,8 +905,8 @@ Applying theorems only on subterms that contain no variables to instantiate and does not traverse tuples. See :ref:`the corresponding example <simple_apply_ex>`. - .. tacv:: {? simple} apply {+, @term {? with @bindings_list}} in @ident {? as @simple_intropattern} - {? simple} eapply {+, @term {? with @bindings_list}} in @ident {? as @simple_intropattern} + .. tacv:: {? simple} apply {+, @term {? with @bindings}} in @ident {? as @simple_intropattern} + {? simple} eapply {+, @term {? with @bindings}} in @ident {? as @simple_intropattern} This summarizes the different syntactic variants of :n:`apply @term in @ident` and :n:`eapply @term in @ident`. @@ -938,48 +932,48 @@ Applying theorems :g:`constructor n` where ``n`` is the number of constructors of the head of the goal. - .. tacv:: constructor @natural with @bindings_list + .. tacv:: constructor @natural with @bindings 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`. + :n:`constructor i with @bindings` is equivalent to + :n:`intros; apply c with @bindings`. .. warning:: - The terms in the :token:`bindings_list` are checked in the context + The terms in :token:`bindings` 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:: split {? with @bindings_list } + .. tacv:: split {? with @bindings } :name: split This applies only if :g:`I` has a single constructor. It is then - equivalent to :n:`constructor 1 {? with @bindings_list }`. It is + equivalent to :n:`constructor 1 {? with @bindings }`. It is typically used in the case of a conjunction :math:`A \wedge B`. - .. tacv:: exists @bindings_list + .. tacv:: exists @bindings :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 + to :n:`intros; constructor 1 with @bindings.` It is typically used in the case of an existential quantification :math:`\exists x, P(x).` - .. tacv:: exists {+, @bindings_list } + .. tacv:: exists {+, @bindings } - This iteratively applies :n:`exists @bindings_list`. + This iteratively applies :n:`exists @bindings`. .. exn:: Not an inductive goal with 1 constructor. :undocumented: - .. tacv:: left {? with @bindings_list } - right {? with @bindings_list } + .. tacv:: left {? with @bindings } + right {? with @bindings } :name: left; right 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 }`. + :n:`constructor 1 {? with @bindings }` and + :n:`constructor 2 {? with @bindings }`. .. exn:: Not an inductive goal with 2 constructors. :undocumented: @@ -1299,7 +1293,7 @@ Managing the local context .. tacv:: set @term {? in @goal_occurrences } This behaves as :n:`set (@ident := @term) {? in @goal_occurrences }` - but :token:`ident` is generated by Coq. + but :token:`ident` is generated by |Coq|. .. tacv:: eset (@ident {* @binder } := @term) {? in @goal_occurrences } eset @term {? in @goal_occurrences } @@ -1344,7 +1338,7 @@ Managing the local context .. tacv:: pose @term This behaves as :n:`pose (@ident := @term)` but :token:`ident` is - generated by Coq. + generated by |Coq|. .. tacv:: epose (@ident {* @binder } := @term) epose @term @@ -1406,7 +1400,7 @@ Controlling the proof flow .. tacv:: assert @type This behaves as :n:`assert (@ident : @type)` but :n:`@ident` is - generated by Coq. + generated by |Coq|. .. tacv:: assert @type by @tactic @@ -1486,7 +1480,7 @@ Controlling the proof flow .. tacv:: enough @type This behaves like :n:`enough (@ident : @type)` with the name :token:`ident` of - the hypothesis generated by Coq. + the hypothesis generated by |Coq|. .. tacv:: enough @type as @simple_intropattern @@ -1518,13 +1512,13 @@ Controlling the proof flow list of remaining subgoal to prove. .. tacv:: specialize (@ident {* @term}) {? as @simple_intropattern} - specialize @ident with @bindings_list {? as @simple_intropattern} + specialize @ident with @bindings {? as @simple_intropattern} :name: specialize; _ This tactic works on local hypothesis :n:`@ident`. The premises of this hypothesis (either universal quantifications or non-dependent implications) are instantiated by concrete terms coming either - from arguments :n:`{* @term}` or from a :ref:`bindings list <bindingslist>`. + from arguments :n:`{* @term}` or from :ref:`bindings`. In the first form the application to :n:`{* @term}` can be partial. The first form is equivalent to :n:`assert (@ident := @ident {* @term})`. In the second form, instantiation elements can also be partial. In this case the @@ -1611,7 +1605,7 @@ name of the variable (here :g:`n`) is chosen based on :g:`T`. must have given the name explicitly (see :ref:`Existential-Variables`). .. note:: When you are referring to hypotheses which you did not name - explicitly, be aware that Coq may make a different decision on how to + explicitly, be aware that |Coq| may make a different decision on how to name the variable in the current goal and in the context of the existential variable. This can lead to surprising behaviors. @@ -1765,9 +1759,9 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) 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_intropattern` (see :tacn:`intros`), - in particular ``?`` can be used to let Coq generate a fresh name. + in particular ``?`` can be used to let |Coq| generate a fresh name. - .. tacv:: destruct @term with @bindings_list + .. tacv:: destruct @term with @bindings This behaves like :n:`destruct @term` providing explicit instances for the dependent premises of the type of :token:`term`. @@ -1781,9 +1775,9 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) are left as existential variables to be inferred later, in the same way as :tacn:`eapply` does. - .. tacv:: destruct @term using @term {? with @bindings_list } + .. tacv:: destruct @term using @term {? with @bindings } - This is synonym of :n:`induction @term using @term {? with @bindings_list }`. + This is synonym of :n:`induction @term using @term {? with @bindings }`. .. tacv:: destruct @term in @goal_occurrences @@ -1792,8 +1786,8 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) clause is an occurrence clause whose syntax and behavior is described in :ref:`occurrences sets <occurrencessets>`. - .. tacv:: destruct @term {? with @bindings_list } {? as @or_and_intropattern_loc } {? eqn:@naming_intropattern } {? using @term {? with @bindings_list } } {? in @goal_occurrences } - edestruct @term {? with @bindings_list } {? as @or_and_intropattern_loc } {? eqn:@naming_intropattern } {? using @term {? with @bindings_list } } {? in @goal_occurrences } + .. tacv:: destruct @term {? with @bindings } {? as @or_and_intropattern_loc } {? eqn:@naming_intropattern } {? using @term {? with @bindings } } {? in @goal_occurrences } + edestruct @term {? with @bindings } {? as @or_and_intropattern_loc } {? eqn:@naming_intropattern } {? using @term {? with @bindings } } {? in @goal_occurrences } These are the general forms of :tacn:`destruct` and :tacn:`edestruct`. They combine the effects of the ``with``, ``as``, ``eqn:``, ``using``, @@ -1806,15 +1800,15 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) recursion. It behaves as :n:`elim @term` but using a case-analysis elimination principle and not a recursive one. -.. tacv:: case @term with @bindings_list +.. tacv:: case @term with @bindings - Analogous to :n:`elim @term with @bindings_list` above. + Analogous to :n:`elim @term with @bindings` above. -.. tacv:: ecase @term {? with @bindings_list } +.. tacv:: ecase @term {? with @bindings } :name: ecase In case the type of :n:`@term` has dependent premises, or dependent premises - whose values are not inferable from the :n:`with @bindings_list` clause, + whose values are not inferable from the :n:`with @bindings` clause, :n:`ecase` turns them into existential variables to be resolved later on. .. tacv:: simple destruct @ident @@ -1906,10 +1900,10 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) :n:`(p`:sub:`1` :n:`, ... , p`:sub:`n` :n:`)` can be used instead of :n:`[ p`:sub:`1` :n:`... p`:sub:`n` :n:`]`. -.. tacv:: induction @term with @bindings_list +.. tacv:: induction @term with @bindings This behaves like :tacn:`induction` providing explicit instances for the - premises of the type of :n:`term` (see :ref:`bindings list <bindingslist>`). + premises of the type of :n:`term` (see :ref:`bindings`). .. tacv:: einduction @term :name: einduction @@ -1926,7 +1920,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) It does not expect the conclusion of the type of the first :n:`@term` to be inductive. -.. tacv:: induction @term using @term with @bindings_list +.. tacv:: induction @term using @term with @bindings This behaves as :tacn:`induction … using …` but also providing instances for the premises of the type of the second :n:`@term`. @@ -1954,8 +1948,8 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) induction y in x |- *. Show 2. -.. tacv:: induction @term with @bindings_list as @or_and_intropattern_loc using @term with @bindings_list in @goal_occurrences - einduction @term with @bindings_list as @or_and_intropattern_loc using @term with @bindings_list in @goal_occurrences +.. tacv:: induction @term with @bindings as @or_and_intropattern_loc using @term with @bindings in @goal_occurrences + einduction @term with @bindings as @or_and_intropattern_loc using @term with @bindings in @goal_occurrences These are the most general forms of :tacn:`induction` and :tacn:`einduction`. It combines the effects of the with, as, using, and in clauses. @@ -1978,11 +1972,11 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) products, the tactic tries to find an instance for which the elimination lemma applies and fails otherwise. -.. tacv:: elim @term with @bindings_list +.. tacv:: elim @term with @bindings :name: elim … with Allows to give explicit instances to the premises of the type of :n:`@term` - (see :ref:`bindings list <bindingslist>`). + (see :ref:`bindings`). .. tacv:: eelim @term :name: eelim @@ -1991,15 +1985,15 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) existential variables to be resolved later on. .. tacv:: elim @term using @term - elim @term using @term with @bindings_list + elim @term using @term with @bindings Allows the user to give explicitly an induction principle :n:`@term` that is not the standard one for the underlying inductive type of :n:`@term`. The - :n:`@bindings_list` clause allows instantiating premises of the type of + :n:`@bindings` clause allows instantiating premises of the type of :n:`@term`. -.. tacv:: elim @term with @bindings_list using @term with @bindings_list - eelim @term with @bindings_list using @term with @bindings_list +.. tacv:: elim @term with @bindings using @term with @bindings + eelim @term with @bindings using @term with @bindings These are the most general forms of :tacn:`elim` and :tacn:`eelim`. It combines the effects of the ``using`` clause and of the two uses of the ``with`` clause. @@ -2148,13 +2142,13 @@ and an explanation of the underlying technique. :n:`discriminate @ident` where :n:`@ident` is the identifier for the last introduced hypothesis. -.. tacv:: discriminate @term with @bindings_list +.. tacv:: discriminate @term with @bindings This does the same thing as :n:`discriminate @term` but using the given bindings to instantiate parameters or hypotheses of :n:`@term`. .. tacv:: ediscriminate @natural - ediscriminate @term {? with @bindings_list} + ediscriminate @term {? with @bindings} :name: ediscriminate; _ This works the same as :tacn:`discriminate` but if the type of :token:`term`, or the @@ -2212,7 +2206,7 @@ and an explanation of the underlying technique. different types :g:`(P t`:sub:`1` :g:`... t`:sub:`n` :g:`)` and :g:`(P u`:sub:`1` :g:`... u`:sub:`n` :sub:`)`. If :g:`t`:sub:`1` and :g:`u`:sub:`1` are the same and have for type an inductive type for which a decidable - equality has been declared using the command :cmd:`Scheme Equality` + equality has been declared using :cmd:`Scheme` :n:`Equality ...` (see :ref:`proofschemes-induction-principles`), the use of a sigma type is avoided. @@ -2237,13 +2231,13 @@ and an explanation of the underlying technique. :n:`injection @ident` where :n:`@ident` is the identifier for the last introduced hypothesis. - .. tacv:: injection @term with @bindings_list + .. tacv:: injection @term with @bindings This does the same as :n:`injection @term` but using the given bindings to instantiate parameters or hypotheses of :n:`@term`. .. tacv:: einjection @natural - einjection @term {? with @bindings_list} + einjection @term {? with @bindings} :name: einjection; _ This works the same as :n:`injection` but if the type of :n:`@term`, or the @@ -2258,10 +2252,10 @@ and an explanation of the underlying technique. .. exn:: goal does not satisfy the expected preconditions. :undocumented: - .. tacv:: injection @term {? with @bindings_list} as {+ @simple_intropattern} + .. tacv:: injection @term {? with @bindings} as {+ @simple_intropattern} injection @natural as {+ @simple_intropattern} injection as {+ @simple_intropattern} - einjection @term {? with @bindings_list} as {+ @simple_intropattern} + einjection @term {? with @bindings} as {+ @simple_intropattern} einjection @natural as {+ @simple_intropattern} einjection as {+ @simple_intropattern} @@ -2273,10 +2267,10 @@ and an explanation of the underlying technique. to the number of new equalities. The original equality is erased if it corresponds to a hypothesis. - .. tacv:: injection @term {? with @bindings_list} as @injection_intropattern + .. tacv:: injection @term {? with @bindings} as @injection_intropattern injection @natural as @injection_intropattern injection as @injection_intropattern - einjection @term {? with @bindings_list} as @injection_intropattern + einjection @term {? with @bindings} as @injection_intropattern einjection @natural as @injection_intropattern einjection as @injection_intropattern @@ -2359,7 +2353,7 @@ and an explanation of the underlying technique. ``inversion`` generally behaves in a slightly more expectable way than ``inversion`` (no artificial duplication of some hypotheses referring to other hypotheses). To take benefit of these improvements, it is enough to use - ``inversion ... as []``, letting the names being finally chosen by Coq. + ``inversion ... as []``, letting the names being finally chosen by |Coq|. .. example:: @@ -3029,7 +3023,7 @@ the conversion in hypotheses :n:`{+ @ident}`. These parameterized reduction tactics apply to any goal and perform the normalization of the goal according to the specified flags. In - correspondence with the kinds of reduction considered in Coq namely + correspondence with the kinds of reduction considered in |Coq| namely :math:`\beta` (reduction of functional application), :math:`\delta` (unfolding of transparent constants, see :ref:`vernac-controlling-the-reduction-strategies`), :math:`\iota` (reduction of @@ -3111,8 +3105,8 @@ the conversion in hypotheses :n:`{+ @ident}`. .. tacv:: native_compute :name: native_compute - This tactic evaluates the goal by compilation to OCaml as described - in :cite:`FullReduction`. If Coq is running in native code, it can be + This tactic evaluates the goal by compilation to |OCaml| as described + in :cite:`FullReduction`. If |Coq| is running in native code, it can be typically two to five times faster than :tacn:`vm_compute`. Note however that the compilation cost is higher, so it is worth using only for intensive computations. @@ -4024,14 +4018,14 @@ automatically created. ``typeclass_instances`` hint database. -Hint databases defined in the Coq standard library -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Hint databases defined in the |Coq| standard library +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Several hint databases are defined in the Coq standard library. The +Several hint databases are defined in the |Coq| standard library. The actual content of a database is the collection of hints declared to belong to this database in each of the various modules currently loaded. Especially, requiring new modules may extend the database. -At Coq startup, only the core database is nonempty and can be used. +At |Coq| startup, only the core database is nonempty and can be used. :core: This special database is automatically used by ``auto``, except when pseudo-database ``nocore`` is given to ``auto``. The core database @@ -4124,7 +4118,7 @@ use one or several databases specific to your development. Adds the rewriting rules :n:`{+ @term}` with a right-to-left orientation in the bases :n:`{+ @ident}`. -.. cmd:: Hint Rewrite {+ @term} using @tactic : {+ @ident} +.. cmd:: Hint Rewrite {? {| -> | <- } } {+ @one_term } {? using @ltac_expr } {? : {* @ident } } When the rewriting rules :n:`{+ @term}` in :n:`{+ @ident}` will be used, the tactic ``tactic`` will be applied to the generated subgoals, the main subgoal @@ -4152,7 +4146,7 @@ but this is a mere workaround and has some limitations (for instance, external hints cannot be removed). A proper way to fix this issue is to bind the hints to their module scope, as -for most of the other objects Coq uses. Hints should only be made available when +for most of the other objects |Coq| uses. Hints should only be made available when the module they are defined in is imported, not just required. It is very difficult to change the historical behavior, as it would break a lot of scripts. We propose a smooth transitional path by providing the :opt:`Loose Hint Behavior` @@ -4408,7 +4402,7 @@ some incompatibilities. .. exn:: I don’t know how to handle dependent equality. The decision procedure managed to find a proof of the goal or of a - discriminable equality but this proof could not be built in Coq because of + discriminable equality but this proof could not be built in |Coq| because of dependently-typed functions. .. exn:: Goal is solvable by congruence but some arguments are missing. Try congruence with {+ @term}, replacing metavariables by arbitrary terms. @@ -4600,13 +4594,13 @@ symbol :g:`=`. :n:`simplify_eq @ident` where :n:`@ident` is the identifier for the last introduced hypothesis. -.. tacv:: simplify_eq @term with @bindings_list +.. tacv:: simplify_eq @term with @bindings This does the same as :n:`simplify_eq @term` but using the given bindings to instantiate parameters or hypotheses of :n:`@term`. .. tacv:: esimplify_eq @natural - esimplify_eq @term {? with @bindings_list} + esimplify_eq @term {? with @bindings} :name: esimplify_eq; _ This works the same as :tacn:`simplify_eq` but if the type of :n:`@term`, or the @@ -4855,14 +4849,14 @@ Proof maintenance *Experimental.* Many tactics, such as :tacn:`intros`, can automatically generate names, such as "H0" or "H1" for a new hypothesis introduced from a goal. Subsequent proof steps -may explicitly refer to these names. However, future versions of Coq may not assign +may explicitly refer to these names. However, future versions of |Coq| may not assign names exactly the same way, which could cause the proof to fail because the new names don't match the explicit references in the proof. The following "Mangle Names" settings let users find all the places where proofs rely on automatically generated names, which can then be named explicitly to avoid any incompatibility. These -settings cause Coq to generate different names, producing errors for +settings cause |Coq| to generate different names, producing errors for references to automatically generated names. .. flag:: Mangle Names @@ -4884,7 +4878,7 @@ Performance-oriented tactic variants For advanced usage. Similar to :tacn:`change` :n:`@term`, but as an optimization, it skips checking that :n:`@term` is convertible to the goal. - Recall that the Coq kernel typechecks proofs again when they are concluded to + Recall that the |Coq| kernel typechecks proofs again when they are concluded to ensure safety. Hence, using :tacn:`change` checks convertibility twice overall, while :tacn:`change_no_check` can produce ill-typed terms, but checks convertibility only once. diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst index 6c07253bce..301559d69d 100644 --- a/doc/sphinx/proof-engine/vernacular-commands.rst +++ b/doc/sphinx/proof-engine/vernacular-commands.rst @@ -637,10 +637,10 @@ file is a particular case of a module called a *library file*. .. cmd:: Declare ML Module {+ @string } - This commands dynamically loads OCaml compiled code from + This commands dynamically loads |OCaml| compiled code from a :n:`.mllib` file. It is used to load plugins dynamically. The - files must be accessible in the current OCaml loadpath (see the + files must be accessible in the current |OCaml| loadpath (see the command :cmd:`Add ML Path`). The :n:`.mllib` suffix may be omitted. This command is reserved for plugin developers, who should provide @@ -656,7 +656,7 @@ file is a particular case of a module called a *library file*. .. cmd:: Print ML Modules - This prints the name of all OCaml modules loaded with :cmd:`Declare ML Module`. + This prints the name of all |OCaml| modules loaded with :cmd:`Declare ML Module`. To know from where these module were loaded, the user should use the command :cmd:`Locate File`. @@ -719,13 +719,13 @@ the toplevel, and using them in source files is discouraged. .. cmd:: Add ML Path @string - This command adds the path :n:`@string` to the current OCaml + This command adds the path :n:`@string` to the current |OCaml| loadpath (cf. :cmd:`Declare ML Module`). .. cmd:: Print ML Path - This command displays the current OCaml loadpath. This + This command displays the current |OCaml| loadpath. This command makes sense only under the bytecode version of ``coqtop``, i.e. using option ``-byte`` (cf. :cmd:`Declare ML Module`). @@ -794,10 +794,10 @@ Quitting and debugging .. cmd:: Drop - This command temporarily enters the OCaml toplevel. + This command temporarily enters the |OCaml| toplevel. It is a debug facility used by |Coq|’s implementers. Valid only in the bytecode version of coqtop. - The OCaml command: + The |OCaml| command: :: @@ -980,7 +980,7 @@ described first. This command has an effect on unfoldable constants, i.e. on constants defined by :cmd:`Definition` or :cmd:`Let` (with an explicit body), or by a command - assimilated to a definition such as :cmd:`Fixpoint`, :cmd:`Program Definition`, etc, + associated with a definition such as :cmd:`Fixpoint`, etc, or by a proof ended by :cmd:`Defined`. The command tells not to unfold the constants in the :n:`@reference` sequence in tactics using δ-conversion (unfolding a constant is replacing it by its definition). @@ -1230,15 +1230,15 @@ in support libraries of plug-ins. .. _exposing-constants-to-ocaml-libraries: -Exposing constants to OCaml libraries -````````````````````````````````````` +Exposing constants to |OCaml| libraries +``````````````````````````````````````` .. cmd:: Register @qualid__1 as @qualid__2 - Makes the constant :n:`@qualid__1` accessible to OCaml libraries under + Makes the constant :n:`@qualid__1` accessible to |OCaml| libraries under the name :n:`@qualid__2`. The constant can then be dynamically located - in OCaml code by - calling :n:`Coqlib.lib_ref "@qualid__2"`. The OCaml code doesn't need + in |OCaml| code by + calling :n:`Coqlib.lib_ref "@qualid__2"`. The |OCaml| code doesn't need to know where the constant is defined (what file, module, library, etc.). As a special case, when the first segment of :n:`@qualid__2` is :g:`kernel`, @@ -1267,7 +1267,7 @@ Registering primitive operations .. cmd:: Primitive @ident_decl {? : @term } := #@ident - Makes the primitive type or primitive operator :n:`#@ident` defined in OCaml + Makes the primitive type or primitive operator :n:`#@ident` defined in |OCaml| accessible in |Coq| commands and tactics. For internal use by implementors of |Coq|'s standard library or standard library replacements. No space is allowed after the `#`. Invalid values give a syntax diff --git a/doc/sphinx/proofs/creating-tactics/index.rst b/doc/sphinx/proofs/creating-tactics/index.rst index 1af1b0b726..f1d4fa789d 100644 --- a/doc/sphinx/proofs/creating-tactics/index.rst +++ b/doc/sphinx/proofs/creating-tactics/index.rst @@ -18,13 +18,13 @@ new tactics: - `Mtac2 <https://github.com/Mtac2/Mtac2>`_ is an external plugin which provides another typed tactic language. While Ltac2 belongs - to the ML language family, Mtac2 reuses the language of Coq itself - as the language to build Coq tactics. + to the ML language family, Mtac2 reuses the language of |Coq| itself + as the language to build |Coq| tactics. - The most traditional way of building new complex tactics is to write - a Coq plugin in OCaml. Beware that this also requires much more - effort and commitment. A tutorial for writing Coq plugins is - available in the Coq repository in `doc/plugin_tutorial + a |Coq| plugin in |OCaml|. Beware that this also requires much more + effort and commitment. A tutorial for writing |Coq| plugins is + available in the |Coq| repository in `doc/plugin_tutorial <https://github.com/coq/coq/tree/master/doc/plugin_tutorial>`_. .. toctree:: diff --git a/doc/sphinx/proofs/writing-proofs/index.rst b/doc/sphinx/proofs/writing-proofs/index.rst index a279a5957f..3f5526dba8 100644 --- a/doc/sphinx/proofs/writing-proofs/index.rst +++ b/doc/sphinx/proofs/writing-proofs/index.rst @@ -4,7 +4,7 @@ Writing proofs ============== -Coq is an interactive theorem prover, or proof assistant, which means +|Coq| is an interactive theorem prover, or proof assistant, which means that proofs can be constructed interactively through a dialog between the user and the assistant. The building blocks for this dialog are tactics which the user will use to represent steps in the proof of a diff --git a/doc/sphinx/user-extensions/proof-schemes.rst b/doc/sphinx/user-extensions/proof-schemes.rst index 8e23e61018..abecee8459 100644 --- a/doc/sphinx/user-extensions/proof-schemes.rst +++ b/doc/sphinx/user-extensions/proof-schemes.rst @@ -8,35 +8,36 @@ Proof schemes Generation of induction principles with ``Scheme`` -------------------------------------------------------- -The ``Scheme`` command is a high-level tool for generating automatically -(possibly mutual) induction principles for given types and sorts. Its -syntax follows the schema: +.. cmd:: Scheme {? @ident := } @scheme_kind {* with {? @ident := } @scheme_kind } -.. cmd:: Scheme @ident__1 := Induction for @ident__2 Sort @sort {* with @ident__i := Induction for @ident__j Sort @sort} + .. insertprodn scheme_kind sort_family - This command is a high-level tool for generating automatically + .. prodn:: + scheme_kind ::= Equality for @reference + | {| Induction | Minimality | Elimination | Case } for @reference Sort @sort_family + sort_family ::= Set + | Prop + | SProp + | Type + + A high-level tool for automatically generating (possibly mutual) induction principles for given types and sorts. - Each :n:`@ident__j` is a different inductive type identifier belonging to + Each :n:`@reference` is a different inductive type identifier belonging to the same package of mutual inductive definitions. - The command generates the :n:`@ident__i`\s to be mutually recursive - definitions. Each term :n:`@ident__i` proves a general principle of mutual - induction for objects in type :n:`@ident__j`. - -.. cmdv:: Scheme @ident := Minimality for @ident Sort @sort {* with @ident := Minimality for @ident' Sort @sort} - - Same as before but defines a non-dependent elimination principle more - natural in case of inductively defined relations. + The command generates the :n:`@ident`\s as mutually recursive + definitions. Each term :n:`@ident` proves a general principle of mutual + induction for objects in type :n:`@reference`. -.. cmdv:: Scheme Equality for @ident - :name: Scheme Equality + :n:`@ident` + The name of the scheme. If not provided, the scheme name will be determined automatically + from the sorts involved. - Tries to generate a Boolean equality and a proof of the decidability of the usual equality. If `ident` - involves some other inductive types, their equality has to be defined first. + :n:`Minimality for @reference Sort @sort_family` + Defines a non-dependent elimination principle more natural for inductively defined relations. -.. cmdv:: Scheme Induction for @ident Sort @sort {* with Induction for @ident Sort @sort} - - If you do not provide the name of the schemes, they will be automatically computed from the - sorts involved (works also with Minimality). + :n:`Equality for @reference` + Tries to generate a Boolean equality and a proof of the decidability of the usual equality. + If :token:`reference` involves other inductive types, their equality has to be defined first. .. example:: @@ -128,7 +129,7 @@ Automatic declaration of schemes .. warning:: - You have to be careful with these flags since Coq may now reject well-defined + You have to be careful with these flags since |Coq| may now reject well-defined inductive types because it cannot compute a Boolean equality for them. .. flag:: Rewriting Schemes @@ -138,13 +139,13 @@ Automatic declaration of schemes Combined Scheme ~~~~~~~~~~~~~~~~~~~~~~ -.. cmd:: Combined Scheme @ident from {+, @ident__i} +.. cmd:: Combined Scheme @ident__def from {+, @ident } This command is a tool for combining induction principles generated by the :cmd:`Scheme` command. - Each :n:`@ident__i` is a different inductive principle that must belong + Each :n:`@ident` is a different inductive principle that must belong to the same package of mutual inductive principle definitions. - This command generates :n:`@ident` to be the conjunction of the + This command generates :n:`@ident__def` as the conjunction of the principles: it is built from the common premises of the principles and concluded by the conjunction of their conclusions. In the case where all the inductive principles used are in sort @@ -197,32 +198,30 @@ Combined Scheme Generation of inversion principles with ``Derive`` ``Inversion`` ----------------------------------------------------------------- -.. cmd:: Derive Inversion @ident with @ident Sort @sort - Derive Inversion @ident with (forall {* @binder }, @ident @term) Sort @sort +.. cmd:: Derive Inversion @ident with @one_term {? Sort @sort_family } - This command generates an inversion principle for the - :tacn:`inversion ... using ...` tactic. The first :token:`ident` is the name - of the generated principle. The second :token:`ident` should be an inductive - predicate, and :n:`{* @binder }` the variables occurring in the term - :token:`term`. This command generates the inversion lemma for the sort - :token:`sort` corresponding to the instance :n:`forall {* @binder }, @ident @term`. - When applied, it is equivalent to having inverted the instance with the - tactic :g:`inversion`. + Generates an inversion lemma for the + :tacn:`inversion ... using ...` tactic. :token:`ident` is the name + of the generated lemma. :token:`one_term` should be in the form + :token:`qualid` or :n:`(forall {+ @binder }, @qualid @term)` where + :token:`qualid` is the name of an inductive + predicate and :n:`{+ @binder }` binds the variables occurring in the term + :token:`term`. The lemma is generated for the sort + :token:`sort_family` corresponding to :token:`one_term`. + Applying the lemma is equivalent to inverting the instance with the + :tacn:`inversion` tactic. -.. cmdv:: Derive Inversion_clear @ident with @ident Sort @sort - Derive Inversion_clear @ident with (forall {* @binder }, @ident @term) Sort @sort +.. cmd:: Derive Inversion_clear @ident with @one_term {? Sort @sort_family } When applied, it is equivalent to having inverted the instance with the tactic inversion replaced by the tactic `inversion_clear`. -.. cmdv:: Derive Dependent Inversion @ident with @ident Sort @sort - Derive Dependent Inversion @ident with (forall {* @binder }, @ident @term) Sort @sort +.. cmd:: Derive Dependent Inversion @ident with @one_term Sort @sort_family When applied, it is equivalent to having inverted the instance with the tactic `dependent inversion`. -.. cmdv:: Derive Dependent Inversion_clear @ident with @ident Sort @sort - Derive Dependent Inversion_clear @ident with (forall {* @binder }, @ident @term) Sort @sort +.. cmd:: Derive Dependent Inversion_clear @ident with @one_term Sort @sort_family When applied, it is equivalent to having inverted the instance with the tactic `dependent inversion_clear`. diff --git a/doc/sphinx/user-extensions/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst index 5148fa84c9..0c51361b64 100644 --- a/doc/sphinx/user-extensions/syntax-extensions.rst +++ b/doc/sphinx/user-extensions/syntax-extensions.rst @@ -3,7 +3,7 @@ Syntax extensions and notation scopes ===================================== -In this chapter, we introduce advanced commands to modify the way Coq +In this chapter, we introduce advanced commands to modify the way |Coq| parses and prints objects, i.e. the translations between the concrete and internal representations of terms and commands. @@ -57,22 +57,21 @@ to represent :g:`(and A B)`: Notations must be in double quotes, except when the abbreviation has the form of an ordinary applicative expression; see :ref:`Abbreviations`. The notation consists of *tokens* separated by -spaces. Alphanumeric strings (such as ``A`` and ``B``) are the *parameters* +spaces. Tokens which are identifiers (such as ``A``, ``x0'``, etc.) are the *parameters* of the notation. Each of them must occur at least once in the abbreviated term. The other elements of the string (such as ``/\``) are the *symbols*. -Substrings enclosed in single quotes are treated as literals. This is necessary -for substrings that would otherwise be interpreted as :n:`@ident`\s. Similarly, -every symbol of at least 3 characters and starting with a simple quote -must be quoted (then it starts by two single quotes). Here is an -example. +Identifiers enclosed in single quotes are treated as symbols and thus +lose their role of parameters. In the same vein, every symbol of at +least 3 characters and starting with a simple quote must be quoted +(then it starts with two single quotes). Here is an example. .. coqtop:: in Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3). A notation binds a syntactic expression to a term. Unless the parser -and pretty-printer of Coq already know how to deal with the syntactic +and pretty-printer of |Coq| already know how to deal with the syntactic expression (such as through :cmd:`Reserved Notation` or for notations that contain only literals), explicit precedences and associativity rules have to be given. @@ -82,13 +81,14 @@ associativity rules have to be given. The right-hand side of a notation is interpreted at the time the notation is given. In particular, disambiguation of constants, :ref:`implicit arguments <ImplicitArguments>` and other notations are resolved at the - time of the declaration of the notation. + time of the declaration of the notation. The right-hand side is + currently typed only at use time but this may change in the future. Precedences and associativity ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Mixing different symbolic notations in the same text may cause serious -parsing ambiguity. To deal with the ambiguity of notations, Coq uses +parsing ambiguity. To deal with the ambiguity of notations, |Coq| uses precedence levels ranging from 0 to 100 (plus one extra level numbered 200) and associativity rules. @@ -99,7 +99,7 @@ Consider for example the new notation Notation "A \/ B" := (or A B). Clearly, an expression such as :g:`forall A:Prop, True /\ A \/ A \/ False` -is ambiguous. To tell the Coq parser how to interpret the +is ambiguous. To tell the |Coq| parser how to interpret the expression, a priority between the symbols ``/\`` and ``\/`` has to be given. Assume for instance that we want conjunction to bind more than disjunction. This is expressed by assigning a precedence level to each @@ -117,7 +117,7 @@ defaults to :g:`True /\ (False /\ False)` (right associativity) or to expression is not well-formed and that parentheses are mandatory (this is a “no associativity”) [#no_associativity]_. We do not know of a special convention for the associativity of disjunction and conjunction, so let us apply -right associativity (which is the choice of Coq). +right associativity (which is the choice of |Coq|). Precedence levels and associativity rules of notations are specified with a list of parenthesized :n:`@syntax_modifier`\s. Here is how the previous examples refine: @@ -187,7 +187,7 @@ left. See the next section for more about factorization. Simple factorization rules ~~~~~~~~~~~~~~~~~~~~~~~~~~ -Coq extensible parsing is performed by *Camlp5* which is essentially a LL1 +|Coq| extensible parsing is performed by *Camlp5* which is essentially a LL1 parser: it decides which notation to parse by looking at tokens from left to right. Hence, some care has to be taken not to hide already existing rules by new rules. Some simple left factorization work has to be done. Here is an example. @@ -209,16 +209,16 @@ need to force the parsing level of ``y``, as follows. Notation "x < y" := (lt x y) (at level 70). Notation "x < y < z" := (x < y /\ y < z) (at level 70, y at next level). -For the sake of factorization with Coq predefined rules, simple rules +For the sake of factorization with |Coq| predefined rules, simple rules have to be observed for notations starting with a symbol, e.g., rules starting with “\ ``{``\ ” or “\ ``(``\ ” should be put at level 0. The list -of Coq predefined notations can be found in the chapter on :ref:`thecoqlibrary`. +of |Coq| predefined notations can be found in the chapter on :ref:`thecoqlibrary`. Displaying symbolic notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The command :cmd:`Notation` has an effect both on the Coq parser and on the -Coq printer. For example: +The command :cmd:`Notation` has an effect both on the |Coq| parser and on the +|Coq| printer. For example: .. coqtop:: all @@ -226,7 +226,7 @@ Coq printer. For example: However, printing, especially pretty-printing, also requires some care. We may want specific indentations, line breaks, alignment if on -several lines, etc. For pretty-printing, |Coq| relies on |ocaml| +several lines, etc. For pretty-printing, |Coq| relies on |OCaml| formatting library, which provides indentation and automatic line breaks depending on page width by means of *formatting boxes*. @@ -299,12 +299,29 @@ Notations disappear when a section is closed. No typing of the denoted expression is performed at definition time. Type checking is done only at the time of use of the notation. -.. note:: Sometimes, a notation is expected only for the parser. To do - so, the option ``only parsing`` is allowed in the list of :n:`@syntax_modifier`\s - in :cmd:`Notation`. Conversely, the ``only printing`` :n:`@syntax_modifier` can be - used to declare that a notation should only be used for printing and - should not declare a parsing rule. In particular, such notations do - not modify the parser. +.. note:: + + The default for a notation is to be used both for parsing and + printing. It is possible to declare a notation only for parsing by + adding the option ``only parsing`` to the list of + :n:`@syntax_modifier`\s of :cmd:`Notation`. Symmetrically, the + ``only printing`` :n:`@syntax_modifier` can be used to declare that + a notation should only be used for printing. + + If a notation to be used both for parsing and printing is + overriden, both the parsing and printing are invalided, even if the + overriding rule is only parsing. + + If a given notation string occurs only in ``only printing`` rules, + the parser is not modified at all. + + To a given notation string and scope can be attached at most one + notation with both parsing and printing or with only + parsing. Contrastingly, an arbitrary number of ``only printing`` + notations differing in their right-hand sides but only a unique + right-hand side can be attached to a given string and + scope. Obviously, expressions printed by means of such extra + printing rules will not be reparsed to the same form. The Infix command ~~~~~~~~~~~~~~~~~~ @@ -332,12 +349,12 @@ Reserving notations .. cmd:: Reserved Notation @string {? ( {+, @syntax_modifier } ) } - A given notation may be used in different contexts. Coq expects all + A given notation may be used in different contexts. |Coq| expects all uses of the notation to be defined at the same precedence and with the same associativity. To avoid giving the precedence and associativity every time, this command declares a parsing rule (:token:`string`) in advance without giving its interpretation. Here is an example from the initial - state of Coq. + state of |Coq|. .. coqtop:: in @@ -368,8 +385,8 @@ a :token:`decl_notations` clause after the definition of the (co)inductive type (co)recursive term (or after the definition of each of them in case of mutual definitions). The exact syntax is given by :n:`@decl_notation` for inductive, co-inductive, recursive and corecursive definitions and in :ref:`record-types` -for records. Note that only syntax modifiers that do not require to add or -change a parsing rule are accepted. +for records. Note that only syntax modifiers that do not require adding or +changing a parsing rule are accepted. .. insertprodn decl_notations decl_notation @@ -745,7 +762,7 @@ recursive patterns. The basic example is: Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..). On the right-hand side, an extra construction of the form ``.. t ..`` can -be used. Notice that ``..`` is part of the Coq syntax and it must not be +be used. Notice that ``..`` is part of the |Coq| syntax and it must not be confused with the three-dots notation “``…``” used in this manual to denote a sequence of arbitrary size. @@ -925,7 +942,7 @@ Custom entries Custom entries have levels, like the main grammar of terms and grammar of patterns have. The lower level is 0 and this is the level used by default to put rules delimited with tokens on both ends. The level is -left to be inferred by Coq when using :n:`in custom @ident`. The +left to be inferred by |Coq| when using :n:`in custom @ident`. The level is otherwise given explicitly by using the syntax :n:`in custom @ident at level @natural`, where :n:`@natural` refers to the level. @@ -979,7 +996,7 @@ associated to the custom entry ``expr``. The level can be omitted, as in Notation "[ e ]" := e (e custom expr). -in which case Coq infer it. If the sub-expression is at a border of +in which case |Coq| infer it. If the sub-expression is at a border of the notation (as e.g. ``x`` and ``y`` in ``x + y``), the level is determined by the associativity. If the sub-expression is not at the border of the notation (as e.g. ``e`` in ``"[ e ]``), the level is @@ -1080,7 +1097,7 @@ Here are the syntax elements used by the various notation commands. 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`). + the initial state of |Coq| (see directory :file:`$COQLIB/theories/Init`). .. note:: The notation ``"{ x }"`` has a special status in the main grammars of terms and patterns so that @@ -1105,7 +1122,7 @@ Here are the syntax elements used by the various notation commands. .. warn:: Use of @string Notation is deprecated as it is inconsistent with pattern syntax. This warning is disabled by default to avoid spurious diagnostics - due to legacy notation in the Coq standard library. + due to legacy notation in the |Coq| standard library. It can be turned on with the ``-w disj-pattern-notation`` flag. .. _Scopes: @@ -1139,7 +1156,7 @@ Most commands use :token:`scope_name`; :token:`scope_key`\s are used within :tok .. cmd:: Declare Scope @scope_name Declares a new notation scope. Note that the initial - state of Coq declares the following notation scopes: + state of |Coq| declares the following notation scopes: ``core_scope``, ``type_scope``, ``function_scope``, ``nat_scope``, ``bool_scope``, ``list_scope``, ``int_scope``, ``uint_scope``. @@ -1291,10 +1308,10 @@ recognized to be a ``Funclass`` instance, i.e., of type :g:`forall x:A, B` or .. _notation-scopes: -Notation scopes used in the standard library of Coq -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Notation scopes used in the standard library of |Coq| +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We give an overview of the scopes used in the standard library of Coq. +We give an overview of the scopes used in the standard library of |Coq|. For a complete list of notations in each scope, use the commands :cmd:`Print Scopes` or :cmd:`Print Scope`. @@ -1360,7 +1377,7 @@ Scopes` or :cmd:`Print Scope`. ``string_scope`` This scope includes notation for strings as elements of the type string. - Special characters and escaping follow Coq conventions on strings (see + Special characters and escaping follow |Coq| conventions on strings (see :ref:`lexical-conventions`). Especially, there is no convention to visualize non printable characters of a string. The file :file:`String.v` shows an example that contains quotes, a newline and a beep (i.e. the ASCII character @@ -1461,7 +1478,7 @@ Abbreviations An abbreviation expects no precedence nor associativity, since it is parsed as an usual application. Abbreviations are used as - much as possible by the Coq printers unless the modifier ``(only + much as possible by the |Coq| printers unless the modifier ``(only parsing)`` is given. An abbreviation is bound to an absolute name as an ordinary definition is @@ -1617,7 +1634,7 @@ Number notations with :n:`(abstract after @bignat)`, this warning is emitted when parsing a number greater than or equal to :token:`bignat`. Typically, this indicates that the fully computed representation - of numbers can be so large that non-tail-recursive OCaml + of numbers can be so large that non-tail-recursive |OCaml| functions run out of stack space when trying to walk them. .. warn:: The 'abstract after' directive has no effect when the parsing function (@qualid__parse) targets an option type. @@ -1877,12 +1894,12 @@ Tactic notations allow customizing the syntax of tactics. - :tacn:`unfold`, :tacn:`with_strategy` * - ``constr`` - - :token:`term` + - :token:`one_term` - a term - :tacn:`exact` * - ``uconstr`` - - :token:`term` + - :token:`one_term` - an untyped term - :tacn:`refine` @@ -1961,9 +1978,9 @@ Tactic notations allow customizing the syntax of tactics. .. rubric:: Footnotes .. [#and_or_levels] which are the levels effectively chosen in the current - implementation of Coq + implementation of |Coq| -.. [#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`` +.. [#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/sphinx/using/libraries/funind.rst b/doc/sphinx/using/libraries/funind.rst index 738d64bfc3..93571ecebb 100644 --- a/doc/sphinx/using/libraries/funind.rst +++ b/doc/sphinx/using/libraries/funind.rst @@ -169,13 +169,24 @@ terminating functions. Tactics ------- -.. tacn:: functional induction (@qualid {+ @term}) +.. tacn:: functional induction @term {? using @one_term {? with @bindings } } {? as @simple_intropattern } :name: functional induction - The tactic functional induction performs case analysis and induction - following the definition of a function. It makes use of a principle + Performs case analysis and induction following the definition of a function + :token:`qualid`, which must be fully applied to its arguments as part of + :token:`term`. It uses a principle generated by :cmd:`Function` or :cmd:`Functional Scheme`. Note that this tactic is only available after a ``Require Import FunInd``. + See the :cmd:`Function` command. + + :n:`using @one_term` + Specifies the induction principle (aka elimination scheme). + + :n:`with @bindings` + Specifies the arguments of the induction principle. + + :n:`as @simple_intropattern` + Provides names for the introduced variables. .. example:: @@ -189,15 +200,6 @@ Tactics Qed. .. note:: - :n:`(@qualid {+ @term})` must be a correct full application - of :n:`@qualid`. In particular, the rules for implicit arguments are the - same as usual. For example use :n:`@@qualid` if you want to write implicit - arguments explicitly. - - .. note:: - Parentheses around :n:`@qualid {+ @term}` are not mandatory and can be skipped. - - .. note:: :n:`functional induction (f x1 x2 x3)` is actually a wrapper for :n:`induction x1, x2, x3, (f x1 x2 x3) using @qualid` followed by a cleaning phase, where :n:`@qualid` is the induction principle registered for :g:`f` @@ -218,22 +220,27 @@ Tactics .. exn:: Not the right number of induction arguments. :undocumented: - .. tacv:: functional induction (@qualid {+ @term}) as @simple_intropattern using @term with @bindings_list - - Similarly to :tacn:`induction` and :tacn:`elim`, this allows giving - explicitly the name of the introduced variables, the induction principle, and - the values of dependent premises of the elimination scheme, including - *predicates* for mutual induction when :n:`@qualid` is part of a mutually - recursive definition. - -.. tacn:: functional inversion @ident +.. tacn:: functional inversion {| @ident | @natural } {? @qualid } :name: functional inversion - :tacn:`functional inversion` is a tactic that performs inversion on hypothesis - :n:`@ident` of the form :n:`@qualid {+ @term} = @term` or :n:`@term = @qualid - {+ @term}` where :n:`@qualid` must have been defined using :cmd:`Function`. + Performs inversion on hypothesis + :n:`@ident` of the form :n:`@qualid {+ @term} = @term` or + :n:`@term = @qualid {+ @term}` when :n:`@qualid` is defined using :cmd:`Function`. Note that this tactic is only available after a ``Require Import FunInd``. + :n:`@natural` + Does the same thing as :n:`intros until @natural` followed by + :n:`functional inversion @ident` where :token:`ident` is the + identifier for the last introduced hypothesis. + + :n:`@qualid` + If the hypothesis :token:`ident` (or :token:`natural`) has a type of the form + :n:`@qualid__1 {+ @term__i } = @qualid__2 {+ @term__j }` where + :n:`@qualid__1` and :n:`@qualid__2` are valid candidates to + functional inversion, this variant allows choosing which :token:`qualid` + is inverted. + + .. exn:: Hypothesis @ident must contain at least one Function. :undocumented: @@ -242,39 +249,26 @@ Tactics This error may be raised when some inversion lemma failed to be generated by Function. - - .. tacv:: functional inversion @natural - - This does the same thing as :n:`intros until @natural` followed by - :n:`functional inversion @ident` where :token:`ident` is the - identifier for the last introduced hypothesis. - - .. tacv:: functional inversion @ident @qualid - functional inversion @natural @qualid - - If the hypothesis :token:`ident` (or :token:`natural`) has a type of the form - :n:`@qualid__1 {+ @term__i } = @qualid__2 {+ @term__j }` where - :n:`@qualid__1` and :n:`@qualid__2` are valid candidates to - functional inversion, this variant allows choosing which :token:`qualid` - is inverted. - .. _functional-scheme: Generation of induction principles with ``Functional`` ``Scheme`` ----------------------------------------------------------------- -.. cmd:: Functional Scheme @ident__0 := Induction for @ident' Sort @sort {* with @ident__i := Induction for @ident__i' Sort @sort} +.. cmd:: Functional Scheme @func_scheme_def {* with @func_scheme_def } + + .. insertprodn func_scheme_def func_scheme_def + + .. prodn:: + func_scheme_def ::= @ident := Induction for @qualid Sort @sort_family + + An experimental high-level tool that + automatically generates induction principles corresponding to functions that + may be mutually recursive. The command generates an + induction principle named :n:`@ident` for each given function named :n:`@qualid`. + The :n:`@qualid`\s must be given in the same order as when they were defined. - This command is a high-level experimental tool for - generating automatically induction principles corresponding to - (possibly mutually recursive) functions. First, it must be made - available via ``Require Import FunInd``. - Each :n:`@ident__i` is a different mutually defined function - name (the names must be in the same order as when they were defined). This - command generates the induction principle for each :n:`@ident__i`, following - the recursive structure and case analyses of the corresponding function - :n:`@ident__i'`. + Note the command must be made available via :cmd:`Require Import` ``FunInd``. .. warning:: diff --git a/doc/sphinx/using/libraries/index.rst b/doc/sphinx/using/libraries/index.rst index 0bd3054788..95218322ff 100644 --- a/doc/sphinx/using/libraries/index.rst +++ b/doc/sphinx/using/libraries/index.rst @@ -4,15 +4,15 @@ Libraries and plugins ===================== -Coq is distributed with a standard library and a set of internal +|Coq| is distributed with a standard library and a set of internal plugins (most of which provide tactics that have already been presented in :ref:`writing-proofs`). This chapter presents this standard library and some of these internal plugins which provide features that are not tactics. -In addition, Coq has a rich ecosystem of external libraries and +In addition, |Coq| has a rich ecosystem of external libraries and plugins. These libraries and plugins can be browsed online through -the `Coq Package Index <https://coq.inria.fr/opam/www/>`_ and +the `|Coq| Package Index <https://coq.inria.fr/opam/www/>`_ and installed with the `opam package manager <https://coq.inria.fr/opam-using.html>`_. diff --git a/doc/sphinx/using/libraries/writing.rst b/doc/sphinx/using/libraries/writing.rst index 325ea2af60..724bcd0488 100644 --- a/doc/sphinx/using/libraries/writing.rst +++ b/doc/sphinx/using/libraries/writing.rst @@ -1,9 +1,9 @@ -Writing Coq libraries and plugins -================================= +Writing |Coq| libraries and plugins +=================================== -This section presents the part of the Coq language that is useful only -to library and plugin authors. A tutorial for writing Coq plugins is -available in the Coq repository in `doc/plugin_tutorial +This section presents the part of the |Coq| language that is useful only +to library and plugin authors. A tutorial for writing |Coq| plugins is +available in the |Coq| repository in `doc/plugin_tutorial <https://github.com/coq/coq/tree/master/doc/plugin_tutorial>`_. Deprecating library objects or tactics diff --git a/doc/sphinx/using/tools/coqdoc.rst b/doc/sphinx/using/tools/coqdoc.rst index 9ac3d2adda..88c1a575d9 100644 --- a/doc/sphinx/using/tools/coqdoc.rst +++ b/doc/sphinx/using/tools/coqdoc.rst @@ -253,7 +253,7 @@ The latter cannot be used around some inner parts of a proof, but can be used around a whole proof. Lastly, it is possible to adopt a middle-ground approach when the -desired output is HTML, where a given snippet of Coq material is +desired output is HTML, where a given snippet of |Coq| material is hidden by default, but can be made visible with user interaction. :: @@ -358,11 +358,11 @@ Command line options **Hyperlink options** :--glob-from file: Make references using |Coq| globalizations from file - file. (Such globalizations are obtained with Coq option ``-dump-glob``). + file. (Such globalizations are obtained with |Coq| option ``-dump-glob``). :--no-externals: Do not insert links to the |Coq| standard library. :--external url coqdir: Use given URL for linking references whose name starts with prefix ``coqdir``. - :--coqlib url: Set base URL for the Coq standard library (default is + :--coqlib url: Set base URL for the |Coq| standard library (default is `<http://coq.inria.fr/library/>`_). This is equivalent to ``--external url Coq``. :-R dir coqdir: Recursively map physical directory dir to |Coq| logical diff --git a/doc/sphinx/using/tools/index.rst b/doc/sphinx/using/tools/index.rst index dfe38dfce9..8543c5de8a 100644 --- a/doc/sphinx/using/tools/index.rst +++ b/doc/sphinx/using/tools/index.rst @@ -5,11 +5,11 @@ Command-line and graphical tools ================================ This chapter presents the command-line tools that users will need to -build their Coq project, the documentation of the CoqIDE standalone +build their |Coq| project, the documentation of the |CoqIDE| standalone user interface and the documentation of the parallel proof processing -feature that is supported by CoqIDE and several other user interfaces. -A list of available user interfaces to interact with Coq is available -on the `Coq website <https://coq.inria.fr/user-interfaces.html>`_. +feature that is supported by |CoqIDE| and several other user interfaces. +A list of available user interfaces to interact with |Coq| is available +on the `|Coq| website <https://coq.inria.fr/user-interfaces.html>`_. .. toctree:: :maxdepth: 1 diff --git a/doc/stdlib/hidden-files b/doc/stdlib/hidden-files index f39c50238a..4d2972ef8f 100644 --- a/doc/stdlib/hidden-files +++ b/doc/stdlib/hidden-files @@ -50,6 +50,7 @@ theories/micromega/ZCoeff.v theories/micromega/ZMicromega.v theories/micromega/ZifyInst.v theories/micromega/ZifyBool.v +theories/micromega/ZifyInt63.v theories/micromega/ZifyComparison.v theories/micromega/ZifyClasses.v theories/micromega/ZifyPow.v diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg index a22f7ae9f3..f9aba5b1e1 100644 --- a/doc/tools/docgram/common.edit_mlg +++ b/doc/tools/docgram/common.edit_mlg @@ -103,7 +103,7 @@ RENAME: [ | Constr.lconstr lconstr | Constr.lconstr_pattern cpattern | G_vernac.query_command query_command -| G_vernac.section_subset_expr section_subset_expr +| G_vernac.section_subset_expr section_var_expr | Prim.ident ident | Prim.reference reference | Pvernac.Vernac_.main_entry vernac_control @@ -182,10 +182,6 @@ DELETE: [ (* additional nts to be spliced *) -hyp: [ -| var -] - tactic_then_last: [ | REPLACE "|" LIST0 ( OPT tactic_expr5 ) SEP "|" | WITH LIST0 ( "|" ( OPT tactic_expr5 ) ) @@ -303,9 +299,9 @@ atomic_constr: [ | MOVETO primitive_notations NUMBER | MOVETO primitive_notations string | MOVETO term_evar "_" -| REPLACE "?" "[" ident "]" -| WITH "?[" ident "]" -| MOVETO term_evar "?[" ident "]" +| REPLACE "?" "[" identref "]" +| WITH "?[" identref "]" +| MOVETO term_evar "?[" identref "]" | REPLACE "?" "[" pattern_ident "]" | WITH "?[" pattern_ident "]" | MOVETO term_evar "?[" pattern_ident "]" @@ -373,7 +369,7 @@ operconstr10: [ | MOVETO term_application operconstr9 LIST1 appl_arg | MOVETO term_application "@" qualid_annotated LIST1 operconstr9 (* fixme: add in as a prodn somewhere *) -| MOVETO dangling_pattern_extension_rule "@" pattern_identref LIST1 identref +| MOVETO dangling_pattern_extension_rule "@" pattern_ident LIST1 identref | DELETE dangling_pattern_extension_rule ] @@ -396,8 +392,8 @@ operconstr0: [ (* @Zimmi48: This rule is a hack, according to Hugo, and should not be shown in the manual. *) | DELETE "{" binder_constr "}" | REPLACE "{|" record_declaration bar_cbrace -| WITH "{|" LIST0 field_def bar_cbrace -| MOVETO term_record "{|" LIST0 field_def bar_cbrace +| WITH "{|" LIST0 field_def SEP ";" OPT ";" bar_cbrace +| MOVETO term_record "{|" LIST0 field_def SEP ";" OPT ";" bar_cbrace | MOVETO term_generalizing "`{" operconstr200 "}" | MOVETO term_generalizing "`(" operconstr200 ")" | MOVETO term_ltac "ltac" ":" "(" tactic_expr5 ")" @@ -545,7 +541,13 @@ evar_instance: [ (* No constructor syntax, OPT [ "|" binders ] is not supported for Record *) record_definition: [ -| opt_coercion ident_decl binders OPT [ ":" type ] OPT [ identref ] "{" record_fields "}" decl_notations +| opt_coercion ident_decl binders OPT [ ":" sort ] OPT ( ":=" OPT [ identref ] "{" record_fields "}" ) +] + +(* No mutual recursion, no inductive classes, type must be a sort *) +(* constructor is optional but "Class record_definition" covers that case *) +singleton_class_definition: [ +| opt_coercion ident_decl binders OPT [ ":" sort ] ":=" constructor ] (* No record syntax, opt_coercion not supported for Variant, := ... required *) @@ -562,7 +564,8 @@ gallina: [ | "CoInductive" inductive_definition LIST0 ( "with" inductive_definition ) | "Variant" variant_definition LIST0 ( "with" variant_definition ) | [ "Record" | "Structure" ] record_definition LIST0 ( "with" record_definition ) -| "Class" inductive_definition LIST0 ( "with" inductive_definition ) +| "Class" record_definition +| "Class" singleton_class_definition | REPLACE "Fixpoint" LIST1 rec_definition SEP "with" | WITH "Fixpoint" rec_definition LIST0 ( "with" rec_definition ) | REPLACE "Let" "Fixpoint" LIST1 rec_definition SEP "with" @@ -585,7 +588,7 @@ constructor_list_or_record_decl: [ record_fields: [ | REPLACE record_field ";" record_fields -| WITH LIST0 record_field SEP ";" +| WITH LIST0 record_field SEP ";" OPT ";" | DELETE record_field | DELETE (* empty *) ] @@ -615,7 +618,7 @@ of_type_with_opt_coercion: [ ] of_type_with_opt_coercion: [ -| [ ":" | ":>" | ":>>" ] type +| [ ":" | ":>" ] type ] attribute_value: [ @@ -713,6 +716,10 @@ gallina_ext: [ | REPLACE "Coercion" by_notation ":" class_rawexpr ">->" class_rawexpr | WITH "Coercion" smart_global ":" class_rawexpr ">->" class_rawexpr +(* semantically restricted per https://github.com/coq/coq/pull/12936#discussion_r492705820 *) +| REPLACE "Coercion" global OPT univ_decl def_body +| WITH "Coercion" ident OPT univ_decl def_body + | REPLACE "Include" "Type" module_type_inl LIST0 ext_module_type | WITH "Include" "Type" LIST1 module_type_inl SEP "<+" @@ -725,7 +732,7 @@ gallina_ext: [ | REPLACE "Export" "Unset" option_table | WITH "Unset" option_table | REPLACE "Instance" instance_name ":" operconstr200 hint_info [ ":=" "{" record_declaration "}" | ":=" lconstr | ] -| WITH "Instance" instance_name ":" operconstr200 hint_info OPT [ ":=" "{" record_declaration "}" | ":=" lconstr ] +| WITH "Instance" instance_name ":" type hint_info OPT [ ":=" "{" record_declaration "}" | ":=" lconstr ] | REPLACE "From" global "Require" export_token LIST1 global | WITH "From" dirpath "Require" export_token LIST1 global @@ -1083,8 +1090,8 @@ simple_tactic: [ | EDIT "psatz_R" ADD_OPT int_or_var tactic | EDIT "psatz_Q" ADD_OPT int_or_var tactic | EDIT "psatz_Z" ADD_OPT int_or_var tactic -| REPLACE "subst" LIST1 var -| WITH "subst" OPT ( LIST1 var ) +| REPLACE "subst" LIST1 hyp +| WITH "subst" OPT ( LIST1 hyp ) | DELETE "subst" | DELETE "congruence" | DELETE "congruence" natural @@ -1099,6 +1106,14 @@ simple_tactic: [ | DELETE "transparent_abstract" tactic3 | REPLACE "transparent_abstract" tactic3 "using" ident | WITH "transparent_abstract" tactic_expr3 OPT ( "using" ident ) +| REPLACE "typeclasses" "eauto" "bfs" OPT int_or_var "with" LIST1 preident +| WITH "typeclasses" "eauto" OPT "bfs" OPT int_or_var OPT ( "with" LIST1 preident ) +| DELETE "typeclasses" "eauto" OPT int_or_var "with" LIST1 preident +| DELETE "typeclasses" "eauto" "bfs" OPT int_or_var +| DELETE "typeclasses" "eauto" OPT int_or_var +(* in Tactic Notation: *) +| "setoid_replace" constr "with" constr OPT ( "using" "relation" constr ) OPT ( "in" hyp ) + OPT ( "at" LIST1 int_or_var ) OPT ( "by" tactic_expr3 ) ] (* todo: don't use DELETENT for this *) @@ -1130,6 +1145,23 @@ printable: [ | INSERTALL "Print" ] +add_zify: [ +| [ "InjTyp" | "BinOp" | "UnOp" | "CstOp" | "BinRel" | "UnOpSpec" | "BinOpSpec" ] TAG Micromega +| [ "PropOp" | "PropBinOp" | "PropUOp" | "Saturate" ]TAG Micromega +] + +show_zify: [ +| [ "InjTyp" | "BinOp" | "UnOp" | "CstOp" | "BinRel" | "UnOpSpec" | "BinOpSpec" | "Spec" ] TAG Micromega +] + +scheme_kind: [ +| DELETE "Induction" "for" smart_global "Sort" sort_family +| DELETE "Minimality" "for" smart_global "Sort" sort_family +| DELETE "Elimination" "for" smart_global "Sort" sort_family +| DELETE "Case" "for" smart_global "Sort" sort_family +| [ "Induction" | "Minimality" | "Elimination" | "Case" ] "for" smart_global "Sort" sort_family +] + command: [ | REPLACE "Print" printable | WITH printable @@ -1202,7 +1234,7 @@ command: [ | WITH "Next" "Obligation" OPT ( "of" ident ) withtac | DELETE "Next" "Obligation" withtac | REPLACE "Obligation" natural "of" ident ":" lglob withtac -| WITH "Obligation" natural OPT ( "of" ident ) OPT ( ":" lglob withtac ) +| WITH "Obligation" natural OPT ( "of" ident ) OPT ( ":" type withtac ) | DELETE "Obligation" natural "of" ident withtac | DELETE "Obligation" natural ":" lglob withtac | DELETE "Obligation" natural withtac @@ -1232,13 +1264,14 @@ command: [ | REPLACE "Solve" "All" "Obligations" "with" tactic | WITH "Solve" "All" "Obligations" OPT ( "with" tactic ) | DELETE "Solve" "All" "Obligations" +| DELETE "Solve" "Obligations" "of" ident "with" tactic +| DELETE "Solve" "Obligations" "of" ident +| DELETE "Solve" "Obligations" "with" tactic +| DELETE "Solve" "Obligations" +| "Solve" "Obligations" OPT ( "of" ident ) OPT ( "with" tactic ) | REPLACE "Solve" "Obligation" natural "of" ident "with" tactic | WITH "Solve" "Obligation" natural OPT ( "of" ident ) "with" tactic -| DELETE "Solve" "Obligations" | DELETE "Solve" "Obligation" natural "with" tactic -| REPLACE "Solve" "Obligations" "of" ident "with" tactic -| WITH "Solve" "Obligations" OPT ( OPT ( "of" ident ) "with" tactic ) -| DELETE "Solve" "Obligations" "with" tactic | DELETE "Undo" | DELETE "Undo" natural | REPLACE "Undo" "To" natural @@ -1263,10 +1296,36 @@ command: [ (* odd that these are in command while other notation-related ones are in syntax *) | REPLACE "Numeral" "Notation" reference reference reference ":" ident numnotoption | WITH "Numeral" "Notation" reference reference reference ":" scope_name numnotoption +| REPLACE "Number" "Notation" reference reference reference ":" ident numnotoption +| WITH "Number" "Notation" reference reference reference ":" scope_name numnotoption | REPLACE "String" "Notation" reference reference reference ":" ident | WITH "String" "Notation" reference reference reference ":" scope_name | DELETE "Ltac2" ltac2_entry (* was split up *) +| DELETE "Add" "Zify" "InjTyp" constr (* micromega plugin *) +| DELETE "Add" "Zify" "BinOp" constr (* micromega plugin *) +| DELETE "Add" "Zify" "UnOp" constr (* micromega plugin *) +| DELETE "Add" "Zify" "CstOp" constr (* micromega plugin *) +| DELETE "Add" "Zify" "BinRel" constr (* micromega plugin *) +| DELETE "Add" "Zify" "PropOp" constr (* micromega plugin *) +| DELETE "Add" "Zify" "PropBinOp" constr (* micromega plugin *) +| DELETE "Add" "Zify" "PropUOp" constr (* micromega plugin *) +| DELETE "Add" "Zify" "BinOpSpec" constr (* micromega plugin *) +| DELETE "Add" "Zify" "UnOpSpec" constr (* micromega plugin *) +| DELETE "Add" "Zify" "Saturate" constr (* micromega plugin *) +| "Add" "Zify" add_zify constr TAG Micromega + +| DELETE "Show" "Zify" "InjTyp" (* micromega plugin *) +| DELETE "Show" "Zify" "BinOp" (* micromega plugin *) +| DELETE "Show" "Zify" "UnOp" (* micromega plugin *) +| DELETE "Show" "Zify" "CstOp" (* micromega plugin *) +| DELETE "Show" "Zify" "BinRel" (* micromega plugin *) +| DELETE "Show" "Zify" "UnOpSpec" (* micromega plugin *) +| DELETE "Show" "Zify" "BinOpSpec" (* micromega plugin *) +(* keep this one | "Show" "Zify" "Spec" (* micromega plugin *)*) +| "Show" "Zify" show_zify TAG Micromega +| REPLACE "Goal" lconstr +| WITH "Goal" type ] option_setting: [ @@ -1394,7 +1453,7 @@ type_cstr: [ inductive_definition: [ | REPLACE opt_coercion ident_decl binders OPT [ "|" binders ] OPT [ ":" lconstr ] opt_constructors_or_fields decl_notations -| WITH opt_coercion ident_decl binders OPT [ "|" binders ] OPT [ ":" type ] opt_constructors_or_fields decl_notations +| WITH opt_coercion ident_decl binders OPT [ "|" binders ] OPT [ ":" type ] opt_constructors_or_fields decl_notations ] (* note that constructor -> identref constructor_type *) @@ -1617,7 +1676,7 @@ eauto_search_strategy: [ constr_body: [ | DELETE ":=" lconstr | REPLACE ":" lconstr ":=" lconstr -| WITH OPT ( ":" lconstr ) ":=" lconstr +| WITH OPT ( ":" type ) ":=" lconstr ] opt_hintbases: [ @@ -1769,8 +1828,15 @@ tactic_mode: [ | ltac_info tactic | MOVETO command ltac_info tactic | DELETE command +| REPLACE OPT toplevel_selector "{" +(* semantically restricted *) +| WITH OPT ( [ natural | "[" ident "]" ] ":" ) "{" +| MOVETO simple_tactic OPT ( [ natural | "[" ident "]" ] ":" ) "{" +| DELETE simple_tactic ] +tactic_mode: [ | DELETENT ] + sexpr: [ | REPLACE syn_node (* Ltac2 plugin *) | WITH name TAG Ltac2 @@ -1866,14 +1932,14 @@ ltac_defined_tactics: [ tactic_notation_tactics: [ | "assert_fails" tactic_expr3 | "assert_succeeds" tactic_expr3 -| "field" OPT ( "[" LIST1 operconstr200 "]" ) -| "field_simplify" OPT ( "[" LIST1 operconstr200 "]" ) LIST1 operconstr200 OPT ( "in" ident ) -| "field_simplify_eq" OPT ( "[" LIST1 operconstr200 "]" ) OPT ( "in" ident ) +| "field" OPT ( "[" LIST1 constr "]" ) +| "field_simplify" OPT ( "[" LIST1 constr "]" ) LIST1 constr OPT ( "in" ident ) +| "field_simplify_eq" OPT ( "[" LIST1 constr "]" ) OPT ( "in" ident ) | "intuition" OPT tactic_expr5 -| "nsatz" OPT ( "with" "radicalmax" ":=" operconstr200 "strategy" ":=" operconstr200 "parameters" ":=" operconstr200 "variables" ":=" operconstr200 ) -| "psatz" operconstr200 OPT int_or_var -| "ring" OPT ( "[" LIST1 operconstr200 "]" ) -| "ring_simplify" OPT ( "[" LIST1 operconstr200 "]" ) LIST1 operconstr200 OPT ( "in" ident ) (* todo: ident was "hyp", worth keeping? *) +| "nsatz" OPT ( "with" "radicalmax" ":=" constr "strategy" ":=" constr "parameters" ":=" constr "variables" ":=" constr ) +| "psatz" constr OPT int_or_var +| "ring" OPT ( "[" LIST1 constr "]" ) +| "ring_simplify" OPT ( "[" LIST1 constr "]" ) LIST1 constr OPT ( "in" ident ) (* todo: ident was "hyp", worth keeping? *) ] (* defined in OCaml outside of mlgs *) @@ -2194,6 +2260,36 @@ ltac2_induction_clause: [ | WITH ltac2_destruction_arg OPT ltac2_as_or_and_ipat OPT ltac2_eqn_ipat OPT ltac2_clause TAG Ltac2 ] +starredidentref: [ +| EDIT identref ADD_OPT "*" +| EDIT "Type" ADD_OPT "*" +| "All" +] + +ssexpr0: [ +| DELETE "(" LIST0 starredidentref ")" +| DELETE "(" LIST0 starredidentref ")" "*" +| DELETE "(" ssexpr35 ")" +| DELETE "(" ssexpr35 ")" "*" +| "(" section_subset_expr ")" OPT "*" +] + +ssexpr35: [ +| EDIT ADD_OPT "-" ssexpr50 +] + +simple_binding: [ +| REPLACE "(" ident ":=" lconstr ")" +| WITH "(" [ ident | natural ] ":=" lconstr ")" +| DELETE "(" natural ":=" lconstr ")" +] + + +subprf: [ +| MOVEALLBUT simple_tactic +| "{" (* should be removed. See https://github.com/coq/coq/issues/12004 *) +] + SPLICE: [ | clause | noedit_mode @@ -2204,7 +2300,6 @@ SPLICE: [ | NUMBER | STRING | hyp -| var | identref | pattern_ident | constr_eval (* splices as multiple prods *) @@ -2286,7 +2381,7 @@ SPLICE: [ | decorated_vernac | ext_module_expr | ext_module_type -| pattern_identref +| pattern_ident | test | binder_constr | atomic_constr @@ -2381,6 +2476,13 @@ SPLICE: [ | G_LTAC2_input_fun | ltac2_simple_intropattern_closed | ltac2_with_bindings +| int_or_id +| fun_ind_using +| with_names +| eauto_search_strategy_name +| constr_with_bindings +| simple_binding +| ssexpr35 (* strange in mlg, ssexpr50 is after this *) ] (* end SPLICE *) RENAME: [ @@ -2405,7 +2507,10 @@ RENAME: [ | pattern100 pattern | match_constr term_match (*| impl_ident_tail impl_ident*) -| ssexpr35 ssexpr (* strange in mlg, ssexpr50 is after this *) +| ssexpr50 section_var_expr50 +| ssexpr0 section_var_expr0 +| section_subset_expr section_var_expr +| fun_scheme_arg func_scheme_def | tactic_then_gen for_each_goal | ltac2_tactic_then_gen ltac2_for_each_goal @@ -2415,7 +2520,7 @@ RENAME: [ | BULLET bullet | fix_decl fix_body | cofix_decl cofix_body -(* todo: it's confusing that Constr.constr and constr are different things *) +(* todo: it's confusing that Constr.constr and constr mean different things *) | constr one_term | appl_arg arg | rec_definition fix_definition @@ -2454,6 +2559,7 @@ RENAME: [ | tac2expr1 ltac2_expr1 | tac2expr0 ltac2_expr0 | gmatch_list goal_match_list +| starredidentref starred_ident_ref ] simple_tactic: [ diff --git a/doc/tools/docgram/doc_grammar.ml b/doc/tools/docgram/doc_grammar.ml index 0ac652c0db..b7f1e18d2b 100644 --- a/doc/tools/docgram/doc_grammar.ml +++ b/doc/tools/docgram/doc_grammar.ml @@ -909,14 +909,17 @@ let apply_splice g edit_map = List.iter (fun b -> let (nt0, prods0) = b in let rec splice_loop nt prods cnt = - let max_cnt = 10 in - let (nt', prods') = edit_rule g edit_map nt prods in - if cnt > max_cnt then - error "Splice for '%s' not done after %d iterations\n" nt0 max_cnt; - if nt' = nt && prods' = prods then - (nt', prods') - else - splice_loop nt' prods' (cnt+1) + if cnt >= 10 then begin + error "Splice for '%s' not done after %d iterations. Current value is:\n" nt0 cnt; + List.iter (fun prod -> Printf.eprintf " %s\n" (prod_to_str prod)) prods; + (nt, prods) + end else begin + let (nt', prods') = edit_rule g edit_map nt prods in + if nt' = nt && prods' = prods then + (nt, prods) + else + splice_loop nt' prods' (cnt+1) + end in let (nt', prods') = splice_loop nt0 prods0 0 in g_update_prods g nt' prods') @@ -1724,6 +1727,7 @@ let open_temp_bin file = let match_cmd_regex = Str.regexp "[a-zA-Z0-9_ ]+" let match_subscripts = Str.regexp "__[a-zA-Z0-9]+" +let remove_subscrs str = Str.global_replace match_subscripts "" str let find_longest_match prods str = let get_pfx str = String.trim (if Str.string_match match_cmd_regex str 0 then Str.matched_string str else "") in @@ -1737,7 +1741,6 @@ let find_longest_match prods str = in aux 0 in - let remove_subscrs str = Str.global_replace match_subscripts "" str in let slen = String.length str in let str_pfx = get_pfx str in @@ -1892,25 +1895,15 @@ let process_rst g file args seen tac_prods cmd_prods = (* "doc/sphinx/proof-engine/ssreflect-proof-language.rst"]*) (* in*) - let cmd_replace_files = [ - "doc/sphinx/language/core/records.rst"; - "doc/sphinx/language/core/sections.rst"; - "doc/sphinx/language/extensions/implicit-arguments.rst"; - "doc/sphinx/language/extensions/arguments-command.rst"; - "doc/sphinx/language/gallina-extensions.rst"; - "doc/sphinx/language/gallina-specification-language.rst"; - "doc/sphinx/language/using/libraries/funind.rst"; - "doc/sphinx/proof-engine/ltac.rst"; - "doc/sphinx/proof-engine/ltac2.rst"; - "doc/sphinx/proof-engine/vernacular-commands.rst"; - "doc/sphinx/user-extensions/syntax-extensions.rst"; - "doc/sphinx/proof-engine/vernacular-commands.rst" + let cmd_exclude_files = [ + "doc/sphinx/proof-engine/ssreflect-proof-language.rst"; + "doc/sphinx/proof-engine/tactics.rst" ] in let save_n_get_more direc pfx first_rhs seen_map prods = let replace rhs prods = - if StringSet.is_empty prods || not (List.mem file cmd_replace_files) then + if StringSet.is_empty prods || (List.mem file cmd_exclude_files) then rhs (* no change *) else let mtch, multi, best = find_longest_match prods rhs in @@ -1918,12 +1911,15 @@ let process_rst g file args seen tac_prods cmd_prods = if mtch = rhs then rhs (* no change *) else if mtch = "" then begin - warn "%s line %d: NO MATCH `%s`\n" file !linenum rhs; - if best <> "" then - warn "%s line %d: BEST `%s`\n" file !linenum best; + error "%s line %d: NO MATCH for `%s`\n" file !linenum rhs; + if best <> "" then begin + Printf.eprintf " closest match is: `%s`\n" best; + Printf.eprintf " Please update the rst manually while preserving any subscripts, e.g. 'NT__sub'\n" + end; rhs end else if multi then begin - warn "%s line %d: MULTIMATCH `%s`\n" file !linenum rhs; + error "%s line %d: MULTIPLE MATCHES for `%s`\n" file !linenum rhs; + Printf.eprintf " Please update the rst manually while preserving any subscripts, e.g. 'NT__sub'\n"; rhs end else mtch (* update cmd/tacn *) @@ -1936,7 +1932,7 @@ let process_rst g file args seen tac_prods cmd_prods = fprintf new_rst "%s%s\n" pfx (replace first_rhs prods); - map := NTMap.add first_rhs (file, !linenum) !map; + map := NTMap.add (remove_subscrs first_rhs) (file, !linenum) !map; while let nextline = getline() in ignore (Str.string_match contin_regex nextline 0); @@ -2078,13 +2074,11 @@ let process_grammar args = print_in_order out g `MLG !g.order StringSet.empty; close_out out; finish_with_file (dir "orderedGrammar") args; - check_singletons g + check_singletons g; (* print_dominated g*) - end; - let seen = ref { nts=NTMap.empty; tacs=NTMap.empty; tacvs=NTMap.empty; cmds=NTMap.empty; cmdvs=NTMap.empty } in - let args = { args with no_update = false } in (* always update rsts in place for now *) - if !exit_code = 0 then begin + let seen = ref { nts=NTMap.empty; tacs=NTMap.empty; tacvs=NTMap.empty; cmds=NTMap.empty; cmdvs=NTMap.empty } in + let args = { args with no_update = false } in (* always update rsts in place for now *) let plist nt = let list = (List.map (fun t -> String.trim (prod_to_prodn t)) (NTMap.find nt !g.map)) in @@ -2095,7 +2089,6 @@ let process_grammar args = report_omitted_prods g !seen.nts "Nonterminal" ""; let out = open_out (dir "updated_rsts") in close_out out; - end; (* if args.check_tacs then @@ -2104,7 +2097,6 @@ let process_grammar args = report_omitted_prods cmd_list !seen.cmds "Command" "\n "; *) - if !exit_code = 0 then begin (* generate report on cmds or tacs *) let cmdReport outfile cmdStr cmd_nts cmds cmdvs = let rstCmds = StringSet.of_list (List.map (fun b -> let c, _ = b in c) (NTMap.bindings cmds)) in @@ -2113,7 +2105,7 @@ let process_grammar args = StringSet.union set (StringSet.of_list (List.map (fun p -> String.trim (prod_to_prodn p)) (NTMap.find nt !prodn_gram.map))) ) StringSet.empty cmd_nts in let allCmds = StringSet.union rstCmdvs (StringSet.union rstCmds gramCmds) in - let out = open_temp_bin (dir outfile) in + let out = open_out_bin (dir outfile) in StringSet.iter (fun c -> let rsts = StringSet.mem c rstCmds in let gram = StringSet.mem c gramCmds in @@ -2127,7 +2119,6 @@ let process_grammar args = fprintf out "%s%s %s\n" pfx var c) allCmds; close_out out; - finish_with_file (dir outfile) args; Printf.printf "# %s in rsts, gram, total = %d %d %d\n" cmdStr (StringSet.cardinal gramCmds) (StringSet.cardinal rstCmds) (StringSet.cardinal allCmds); in @@ -2139,17 +2130,16 @@ let process_grammar args = let tac_nts = ["simple_tactic"] in if args.check_tacs then - cmdReport "prodnTactics" "tacs" tac_nts !seen.tacs !seen.tacvs - end; + cmdReport "prodnTactics" "tacs" tac_nts !seen.tacs !seen.tacvs; - (* generate prodnGrammar for reference *) - if !exit_code = 0 && not args.verify then begin - let out = open_temp_bin (dir "prodnGrammar") in - print_in_order out prodn_gram `PRODN !prodn_gram.order StringSet.empty; - close_out out; - finish_with_file (dir "prodnGrammar") args - end - end + (* generate prodnGrammar for reference *) + if not args.verify then begin + let out = open_out_bin (dir "prodnGrammar") in + print_in_order out prodn_gram `PRODN !prodn_gram.order StringSet.empty; + close_out out; + end + end (* if !exit_code = 0 *) + end (* if not args.fullGrammar *) let parse_args () = let suffix_regex = Str.regexp ".*\\.\\([a-z]+\\)$" in diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar index 328175e65c..d3148b5e3a 100644 --- a/doc/tools/docgram/fullGrammar +++ b/doc/tools/docgram/fullGrammar @@ -90,7 +90,7 @@ operconstr90: [ operconstr10: [ | operconstr9 LIST1 appl_arg | "@" global univ_instance LIST0 operconstr9 -| "@" pattern_identref LIST1 identref +| "@" pattern_ident LIST1 identref | operconstr9 ] @@ -155,7 +155,7 @@ binder_constr: [ ] appl_arg: [ -| test_lpar_id_coloneq "(" ident ":=" lconstr ")" +| test_lpar_id_coloneq "(" identref ":=" lconstr ")" | operconstr9 ] @@ -165,13 +165,13 @@ atomic_constr: [ | NUMBER | string | "_" -| "?" "[" ident "]" +| "?" "[" identref "]" | "?" "[" pattern_ident "]" | pattern_ident evar_instance ] inst: [ -| ident ":=" lconstr +| identref ":=" lconstr ] evar_instance: [ @@ -362,16 +362,12 @@ pattern_ident: [ | LEFTQMARK ident ] -pattern_identref: [ -| pattern_ident -] - -var: [ +identref: [ | ident ] -identref: [ -| ident +hyp: [ +| identref ] field: [ @@ -596,9 +592,9 @@ command: [ | "Optimize" "Proof" | "Optimize" "Heap" | "Hint" "Cut" "[" hints_path "]" opthints -| "Typeclasses" "Transparent" LIST0 reference -| "Typeclasses" "Opaque" LIST0 reference -| "Typeclasses" "eauto" ":=" debug eauto_search_strategy OPT integer +| "Typeclasses" "Transparent" LIST1 reference +| "Typeclasses" "Opaque" LIST1 reference +| "Typeclasses" "eauto" ":=" debug eauto_search_strategy OPT natural | "Proof" "with" Pltac.tactic OPT [ "using" G_vernac.section_subset_expr ] | "Proof" "using" G_vernac.section_subset_expr OPT [ "with" Pltac.tactic ] | "Tactic" "Notation" OPT ltac_tactic_level LIST1 ltac_production_item ":=" tactic @@ -615,6 +611,7 @@ command: [ | "Solve" "Obligation" natural "of" ident "with" tactic | "Solve" "Obligation" natural "with" tactic | "Solve" "Obligations" "of" ident "with" tactic +| "Solve" "Obligations" "of" ident | "Solve" "Obligations" "with" tactic | "Solve" "Obligations" | "Solve" "All" "Obligations" "with" tactic @@ -685,10 +682,10 @@ command: [ | "Show" "Zify" "UnOpSpec" (* micromega plugin *) | "Show" "Zify" "BinOpSpec" (* micromega plugin *) | "Show" "Zify" "Spec" (* micromega plugin *) -| "Add" "Ring" ident ":" constr OPT ring_mods (* setoid_ring plugin *) -| "Print" "Rings" (* setoid_ring plugin *) -| "Add" "Field" ident ":" constr OPT field_mods (* setoid_ring plugin *) -| "Print" "Fields" (* setoid_ring plugin *) +| "Add" "Ring" ident ":" constr OPT ring_mods (* ring plugin *) +| "Print" "Rings" (* ring plugin *) +| "Add" "Field" ident ":" constr OPT field_mods (* ring plugin *) +| "Print" "Fields" (* ring plugin *) | "Number" "Notation" reference reference reference ":" ident numnotoption | "Numeral" "Notation" reference reference reference ":" ident numnotoption | "String" "Notation" reference reference reference ":" ident @@ -986,10 +983,7 @@ constructor: [ ] of_type_with_opt_coercion: [ -| ":>>" -| ":>" ">" | ":>" -| ":" ">" ">" | ":" ">" | ":" ] @@ -1554,7 +1548,7 @@ simple_tactic: [ | "notypeclasses" "refine" uconstr | "simple" "notypeclasses" "refine" uconstr | "solve_constraints" -| "subst" LIST1 var +| "subst" LIST1 hyp | "subst" | "simple" "subst" | "evar" test_lpar_id_colon "(" ident ":" lconstr ")" @@ -1622,6 +1616,7 @@ simple_tactic: [ | "convert_concl_no_check" constr | "typeclasses" "eauto" "bfs" OPT int_or_var "with" LIST1 preident | "typeclasses" "eauto" OPT int_or_var "with" LIST1 preident +| "typeclasses" "eauto" "bfs" OPT int_or_var | "typeclasses" "eauto" OPT int_or_var | "head_of_constr" ident constr | "not_evar" constr @@ -1743,11 +1738,11 @@ simple_tactic: [ | "zify_elim_let" (* micromega plugin *) | "nsatz_compute" constr (* nsatz plugin *) | "omega" (* omega plugin *) +| "protect_fv" string "in" ident (* ring plugin *) +| "protect_fv" string (* ring plugin *) +| "ring_lookup" tactic0 "[" LIST0 constr "]" LIST1 constr (* ring plugin *) +| "field_lookup" tactic "[" LIST0 constr "]" LIST1 constr (* ring plugin *) | "rtauto" -| "protect_fv" string "in" ident (* setoid_ring plugin *) -| "protect_fv" string (* setoid_ring plugin *) -| "ring_lookup" tactic0 "[" LIST0 constr "]" LIST1 constr (* setoid_ring plugin *) -| "field_lookup" tactic "[" LIST0 constr "]" LIST1 constr (* setoid_ring plugin *) ] mlname: [ @@ -1814,7 +1809,7 @@ EXTRAARGS_natural: [ occurrences: [ | LIST1 integer -| var +| hyp ] glob: [ @@ -2531,31 +2526,31 @@ induction_clause_list: [ ] ring_mod: [ -| "decidable" constr (* setoid_ring plugin *) -| "abstract" (* setoid_ring plugin *) -| "morphism" constr (* setoid_ring plugin *) -| "constants" "[" tactic "]" (* setoid_ring plugin *) -| "closed" "[" LIST1 global "]" (* setoid_ring plugin *) -| "preprocess" "[" tactic "]" (* setoid_ring plugin *) -| "postprocess" "[" tactic "]" (* setoid_ring plugin *) -| "setoid" constr constr (* setoid_ring plugin *) -| "sign" constr (* setoid_ring plugin *) -| "power" constr "[" LIST1 global "]" (* setoid_ring plugin *) -| "power_tac" constr "[" tactic "]" (* setoid_ring plugin *) -| "div" constr (* setoid_ring plugin *) +| "decidable" constr (* ring plugin *) +| "abstract" (* ring plugin *) +| "morphism" constr (* ring plugin *) +| "constants" "[" tactic "]" (* ring plugin *) +| "closed" "[" LIST1 global "]" (* ring plugin *) +| "preprocess" "[" tactic "]" (* ring plugin *) +| "postprocess" "[" tactic "]" (* ring plugin *) +| "setoid" constr constr (* ring plugin *) +| "sign" constr (* ring plugin *) +| "power" constr "[" LIST1 global "]" (* ring plugin *) +| "power_tac" constr "[" tactic "]" (* ring plugin *) +| "div" constr (* ring plugin *) ] ring_mods: [ -| "(" LIST1 ring_mod SEP "," ")" (* setoid_ring plugin *) +| "(" LIST1 ring_mod SEP "," ")" (* ring plugin *) ] field_mod: [ -| ring_mod (* setoid_ring plugin *) -| "completeness" constr (* setoid_ring plugin *) +| ring_mod (* ring plugin *) +| "completeness" constr (* ring plugin *) ] field_mods: [ -| "(" LIST1 field_mod SEP "," ")" (* setoid_ring plugin *) +| "(" LIST1 field_mod SEP "," ")" (* ring plugin *) ] numnotoption: [ diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar index 6ae99880b3..ff1efa5375 100644 --- a/doc/tools/docgram/orderedGrammar +++ b/doc/tools/docgram/orderedGrammar @@ -3,10 +3,6 @@ doc_grammar will modify this file to add/remove nonterminals and productions to match editedGrammar, which will remove comments. Not compiled into Coq *) DOC_GRAMMAR -tactic_mode: [ -| OPT ( toplevel_selector ":" ) "{" -] - term: [ | term_forall_or_fun | term_let @@ -114,7 +110,7 @@ ident_decl: [ ] of_type: [ -| [ ":" | ":>" | ":>>" ] type +| [ ":" | ":>" ] type ] qualid: [ @@ -191,6 +187,15 @@ where: [ | "before" ident ] +add_zify: [ +| [ "InjTyp" | "BinOp" | "UnOp" | "CstOp" | "BinRel" | "UnOpSpec" | "BinOpSpec" ] (* Micromega plugin *) +| [ "PropOp" | "PropBinOp" | "PropUOp" | "Saturate" ] (* Micromega plugin *) +] + +show_zify: [ +| [ "InjTyp" | "BinOp" | "UnOp" | "CstOp" | "BinRel" | "UnOpSpec" | "BinOpSpec" | "Spec" ] (* Micromega plugin *) +] + REACHABLE: [ | command | simple_tactic @@ -448,9 +453,7 @@ vernac_aux: [ ] subprf: [ -| bullet | "{" -| "}" ] fix_definition: [ @@ -538,8 +541,12 @@ variant_definition: [ | ident_decl LIST0 binder OPT [ "|" LIST0 binder ] OPT [ ":" type ] ":=" OPT "|" LIST1 constructor SEP "|" OPT decl_notations ] +singleton_class_definition: [ +| OPT ">" ident_decl LIST0 binder OPT [ ":" sort ] ":=" constructor +] + record_definition: [ -| OPT ">" ident_decl LIST0 binder OPT [ ":" type ] OPT ident "{" LIST0 record_field SEP ";" "}" OPT decl_notations +| OPT ">" ident_decl LIST0 binder OPT [ ":" sort ] OPT ( ":=" OPT ident "{" LIST0 record_field SEP ";" OPT ";" "}" ) ] record_field: [ @@ -553,7 +560,7 @@ field_body: [ ] term_record: [ -| "{|" LIST0 field_def "|}" +| "{|" LIST0 field_def SEP ";" OPT ";" "|}" ] field_def: [ @@ -566,7 +573,7 @@ inductive_definition: [ constructors_or_record: [ | OPT "|" LIST1 constructor SEP "|" -| OPT ident "{" LIST0 record_field SEP ";" "}" +| OPT ident "{" LIST0 record_field SEP ";" OPT ";" "}" ] constructor: [ @@ -582,11 +589,8 @@ cofix_definition: [ ] scheme_kind: [ -| "Induction" "for" reference "Sort" sort_family -| "Minimality" "for" reference "Sort" sort_family -| "Elimination" "for" reference "Sort" sort_family -| "Case" "for" reference "Sort" sort_family | "Equality" "for" reference +| [ "Induction" | "Minimality" | "Elimination" | "Case" ] "for" reference "Sort" sort_family ] sort_family: [ @@ -714,7 +718,7 @@ simple_reserv: [ ] command: [ -| "Goal" term +| "Goal" type | "Pwd" | "Cd" OPT string | "Load" OPT "Verbose" [ string | ident ] @@ -723,6 +727,8 @@ command: [ | "Locate" "Term" reference | "Locate" "Module" qualid | "Info" natural ltac_expr +| "Add" "Zify" add_zify one_term (* Micromega plugin *) +| "Show" "Zify" show_zify (* Micromega plugin *) | "Locate" "Ltac" qualid | "Locate" "Library" qualid | "Locate" "File" string @@ -798,7 +804,7 @@ command: [ | "Extraction" "NoInline" LIST1 qualid (* extraction plugin *) | "Print" "Extraction" "Inline" (* extraction plugin *) | "Reset" "Extraction" "Inline" (* extraction plugin *) -| "Extraction" "Implicit" qualid "[" LIST0 int_or_id "]" (* extraction plugin *) +| "Extraction" "Implicit" qualid "[" LIST0 [ ident | integer ] "]" (* extraction plugin *) | "Extraction" "Blacklist" LIST1 ident (* extraction plugin *) | "Print" "Extraction" "Blacklist" (* extraction plugin *) | "Reset" "Extraction" "Blacklist" (* extraction plugin *) @@ -810,7 +816,7 @@ command: [ | "Proof" "Mode" string | "Proof" term | "Abort" OPT [ "All" | ident ] -| "Existential" natural OPT ( ":" term ) ":=" term +| "Existential" natural OPT ( ":" type ) ":=" term | "Admitted" | "Qed" | "Save" ident @@ -835,10 +841,10 @@ command: [ | "Comments" LIST0 [ one_term | string | natural ] | "Declare" "Instance" ident_decl LIST0 binder ":" term OPT hint_info | "Declare" "Scope" scope_name -| "Obligation" natural OPT ( "of" ident ) OPT ( ":" term OPT ( "with" ltac_expr ) ) +| "Obligation" natural OPT ( "of" ident ) OPT ( ":" type OPT ( "with" ltac_expr ) ) | "Next" "Obligation" OPT ( "of" ident ) OPT ( "with" ltac_expr ) | "Solve" "Obligation" natural OPT ( "of" ident ) "with" ltac_expr -| "Solve" "Obligations" OPT ( OPT ( "of" ident ) "with" ltac_expr ) +| "Solve" "Obligations" OPT ( "of" ident ) OPT ( "with" ltac_expr ) | "Solve" "All" "Obligations" OPT ( "with" ltac_expr ) | "Admit" "Obligations" OPT ( "of" ident ) | "Obligation" "Tactic" ":=" ltac_expr @@ -862,17 +868,6 @@ command: [ | "Reset" "Ltac" "Profile" | "Show" "Ltac" "Profile" OPT [ "CutOff" integer | string ] | "Show" "Lia" "Profile" (* micromega plugin *) -| "Add" "Zify" "InjTyp" one_term (* micromega plugin *) -| "Add" "Zify" "BinOp" one_term (* micromega plugin *) -| "Add" "Zify" "UnOp" one_term (* micromega plugin *) -| "Add" "Zify" "CstOp" one_term (* micromega plugin *) -| "Add" "Zify" "BinRel" one_term (* micromega plugin *) -| "Add" "Zify" "PropOp" one_term (* micromega plugin *) -| "Add" "Zify" "PropBinOp" one_term (* micromega plugin *) -| "Add" "Zify" "PropUOp" one_term (* micromega plugin *) -| "Add" "Zify" "BinOpSpec" one_term (* micromega plugin *) -| "Add" "Zify" "UnOpSpec" one_term (* micromega plugin *) -| "Add" "Zify" "Saturate" one_term (* micromega plugin *) | "Add" "InjTyp" one_term (* micromega plugin *) | "Add" "BinOp" one_term (* micromega plugin *) | "Add" "UnOp" one_term (* micromega plugin *) @@ -884,25 +879,18 @@ command: [ | "Add" "BinOpSpec" one_term (* micromega plugin *) | "Add" "UnOpSpec" one_term (* micromega plugin *) | "Add" "Saturate" one_term (* micromega plugin *) -| "Show" "Zify" "InjTyp" (* micromega plugin *) -| "Show" "Zify" "BinOp" (* micromega plugin *) -| "Show" "Zify" "UnOp" (* micromega plugin *) -| "Show" "Zify" "CstOp" (* micromega plugin *) -| "Show" "Zify" "BinRel" (* micromega plugin *) -| "Show" "Zify" "UnOpSpec" (* micromega plugin *) -| "Show" "Zify" "BinOpSpec" (* micromega plugin *) | "Show" "Zify" "Spec" (* micromega plugin *) -| "Add" "Ring" ident ":" one_term OPT ( "(" LIST1 ring_mod SEP "," ")" ) (* setoid_ring plugin *) -| "Print" "Rings" (* setoid_ring plugin *) -| "Add" "Field" ident ":" one_term OPT ( "(" LIST1 field_mod SEP "," ")" ) (* setoid_ring plugin *) -| "Print" "Fields" (* setoid_ring plugin *) -| "Number" "Notation" qualid qualid qualid ":" ident OPT numeral_modifier +| "Add" "Ring" ident ":" one_term OPT ( "(" LIST1 ring_mod SEP "," ")" ) (* ring plugin *) +| "Print" "Rings" (* ring plugin *) +| "Add" "Field" ident ":" one_term OPT ( "(" LIST1 field_mod SEP "," ")" ) (* ring plugin *) +| "Print" "Fields" (* ring plugin *) +| "Number" "Notation" qualid qualid qualid ":" scope_name OPT numeral_modifier | "Hint" "Cut" "[" hints_path "]" OPT ( ":" LIST1 ident ) -| "Typeclasses" "Transparent" LIST0 qualid -| "Typeclasses" "Opaque" LIST0 qualid -| "Typeclasses" "eauto" ":=" OPT "debug" OPT ( "(" eauto_search_strategy_name ")" ) OPT integer -| "Proof" "with" ltac_expr OPT [ "using" section_subset_expr ] -| "Proof" "using" section_subset_expr OPT [ "with" ltac_expr ] +| "Typeclasses" "Transparent" LIST1 qualid +| "Typeclasses" "Opaque" LIST1 qualid +| "Typeclasses" "eauto" ":=" OPT "debug" OPT ( "(" [ "bfs" | "dfs" ] ")" ) OPT natural +| "Proof" "with" ltac_expr OPT [ "using" section_var_expr ] +| "Proof" "using" section_var_expr OPT [ "with" ltac_expr ] | "Tactic" "Notation" OPT ( "(" "at" "level" natural ")" ) LIST1 ltac_production_item ":=" ltac_expr | "Print" "Rewrite" "HintDb" ident | "Print" "Ltac" qualid @@ -911,8 +899,8 @@ command: [ | "Set" "Firstorder" "Solver" ltac_expr | "Print" "Firstorder" "Solver" | "Function" fix_definition LIST0 ( "with" fix_definition ) -| "Functional" "Scheme" fun_scheme_arg LIST0 ( "with" fun_scheme_arg ) -| "Functional" "Case" fun_scheme_arg (* funind plugin *) +| "Functional" "Scheme" func_scheme_def LIST0 ( "with" func_scheme_def ) +| "Functional" "Case" func_scheme_def (* funind plugin *) | "Generate" "graph" "for" qualid (* funind plugin *) | "Hint" "Rewrite" OPT [ "->" | "<-" ] LIST1 one_term OPT ( "using" ltac_expr ) OPT ( ":" LIST0 ident ) | "Derive" "Inversion_clear" ident "with" one_term OPT ( "Sort" sort_family ) @@ -944,13 +932,14 @@ command: [ | "CoInductive" inductive_definition LIST0 ( "with" inductive_definition ) | "Variant" variant_definition LIST0 ( "with" variant_definition ) | [ "Record" | "Structure" ] record_definition LIST0 ( "with" record_definition ) -| "Class" inductive_definition LIST0 ( "with" inductive_definition ) +| "Class" record_definition +| "Class" singleton_class_definition | "Module" OPT [ "Import" | "Export" ] ident LIST0 module_binder OPT of_module_type OPT ( ":=" LIST1 module_expr_inl SEP "<+" ) | "Module" "Type" ident LIST0 module_binder LIST0 ( "<:" module_type_inl ) OPT ( ":=" LIST1 module_type_inl SEP "<+" ) | "Declare" "Module" OPT [ "Import" | "Export" ] ident LIST0 module_binder ":" module_type_inl | "Section" ident | "End" ident -| "Collection" ident ":=" section_subset_expr +| "Collection" ident ":=" section_var_expr | "Require" OPT [ "Import" | "Export" ] LIST1 qualid | "From" dirpath "Require" OPT [ "Import" | "Export" ] LIST1 qualid | "Import" LIST1 filtered_import @@ -962,11 +951,11 @@ command: [ | "Strategy" LIST1 [ strategy_level "[" LIST1 reference "]" ] | "Canonical" OPT "Structure" ident_decl def_body | "Canonical" OPT "Structure" reference -| "Coercion" qualid OPT univ_decl def_body +| "Coercion" ident OPT univ_decl def_body | "Identity" "Coercion" ident ":" class ">->" class | "Coercion" reference ":" class ">->" class | "Context" LIST1 binder -| "Instance" OPT ( ident_decl LIST0 binder ) ":" term OPT hint_info OPT [ ":=" "{" LIST0 field_def "}" | ":=" term ] +| "Instance" OPT ( ident_decl LIST0 binder ) ":" type OPT hint_info OPT [ ":=" "{" LIST0 field_def "}" | ":=" term ] | "Existing" "Instance" qualid OPT hint_info | "Existing" "Instances" LIST1 qualid OPT [ "|" natural ] | "Existing" "Class" qualid @@ -1012,35 +1001,26 @@ command: [ | "Show" "Goal" natural "at" natural ] -section_subset_expr: [ -| LIST0 starredidentref -| ssexpr -] - -ssexpr: [ -| "-" ssexpr50 -| ssexpr50 +section_var_expr: [ +| LIST0 starred_ident_ref +| OPT "-" section_var_expr50 ] -ssexpr50: [ -| ssexpr0 "-" ssexpr0 -| ssexpr0 "+" ssexpr0 -| ssexpr0 +section_var_expr50: [ +| section_var_expr0 "-" section_var_expr0 +| section_var_expr0 "+" section_var_expr0 +| section_var_expr0 ] -ssexpr0: [ -| starredidentref -| "(" LIST0 starredidentref ")" -| "(" LIST0 starredidentref ")" "*" -| "(" ssexpr ")" -| "(" ssexpr ")" "*" +section_var_expr0: [ +| starred_ident_ref +| "(" section_var_expr ")" OPT "*" ] -starredidentref: [ -| ident -| ident "*" -| "Type" -| "Type" "*" +starred_ident_ref: [ +| ident OPT "*" +| "Type" OPT "*" +| "All" ] dirpath: [ @@ -1137,13 +1117,13 @@ lident: [ destruction_arg: [ | natural -| constr_with_bindings +| one_term OPT ( "with" bindings ) | constr_with_bindings_arg ] constr_with_bindings_arg: [ -| ">" constr_with_bindings -| constr_with_bindings +| ">" one_term OPT ( "with" bindings ) +| one_term OPT ( "with" bindings ) ] clause_dft_concl: [ @@ -1262,11 +1242,6 @@ qhyp: [ | lident (* Ltac2 plugin *) ] -int_or_id: [ -| ident -| integer (* extraction plugin *) -] - language: [ | "OCaml" (* extraction plugin *) | "Haskell" (* extraction plugin *) @@ -1274,28 +1249,24 @@ language: [ | "JSON" (* extraction plugin *) ] -fun_scheme_arg: [ -| ident ":=" "Induction" "for" qualid "Sort" sort_family (* funind plugin *) -] - ring_mod: [ -| "decidable" one_term (* setoid_ring plugin *) -| "abstract" (* setoid_ring plugin *) -| "morphism" one_term (* setoid_ring plugin *) -| "constants" "[" ltac_expr "]" (* setoid_ring plugin *) -| "preprocess" "[" ltac_expr "]" (* setoid_ring plugin *) -| "postprocess" "[" ltac_expr "]" (* setoid_ring plugin *) -| "setoid" one_term one_term (* setoid_ring plugin *) -| "sign" one_term (* setoid_ring plugin *) -| "power" one_term "[" LIST1 qualid "]" (* setoid_ring plugin *) -| "power_tac" one_term "[" ltac_expr "]" (* setoid_ring plugin *) -| "div" one_term (* setoid_ring plugin *) -| "closed" "[" LIST1 qualid "]" (* setoid_ring plugin *) +| "decidable" one_term (* ring plugin *) +| "abstract" (* ring plugin *) +| "morphism" one_term (* ring plugin *) +| "constants" "[" ltac_expr "]" (* ring plugin *) +| "preprocess" "[" ltac_expr "]" (* ring plugin *) +| "postprocess" "[" ltac_expr "]" (* ring plugin *) +| "setoid" one_term one_term (* ring plugin *) +| "sign" one_term (* ring plugin *) +| "power" one_term "[" LIST1 qualid "]" (* ring plugin *) +| "power_tac" one_term "[" ltac_expr "]" (* ring plugin *) +| "div" one_term (* ring plugin *) +| "closed" "[" LIST1 qualid "]" (* ring plugin *) ] field_mod: [ -| ring_mod (* setoid_ring plugin *) -| "completeness" one_term (* setoid_ring plugin *) +| ring_mod (* ring plugin *) +| "completeness" one_term (* ring plugin *) ] numeral_modifier: [ @@ -1314,11 +1285,6 @@ hints_path: [ | hints_path hints_path ] -eauto_search_strategy_name: [ -| "bfs" -| "dfs" -] - class: [ | "Funclass" | "Sortclass" @@ -1390,7 +1356,7 @@ simple_tactic: [ | "eright" OPT ( "with" bindings ) | "constructor" OPT int_or_var OPT ( "with" bindings ) | "econstructor" OPT ( int_or_var OPT ( "with" bindings ) ) -| "specialize" constr_with_bindings OPT ( "as" simple_intropattern ) +| "specialize" one_term OPT ( "with" bindings ) OPT ( "as" simple_intropattern ) | "symmetry" OPT ( "in" in_clause ) | "split" OPT ( "with" bindings ) | "esplit" OPT ( "with" bindings ) @@ -1411,6 +1377,10 @@ simple_tactic: [ | "generalize" "dependent" one_term | "replace" one_term "with" one_term OPT clause_dft_concl OPT ( "by" ltac_expr3 ) | "replace" OPT [ "->" | "<-" ] one_term OPT clause_dft_concl +| "setoid_replace" one_term "with" one_term OPT ( "using" "relation" one_term ) OPT ( "in" ident ) OPT ( "at" LIST1 int_or_var ) OPT ( "by" ltac_expr3 ) +| OPT ( [ natural | "[" ident "]" ] ":" ) "{" +| bullet +| "}" | "try" ltac_expr3 | "do" int_or_var ltac_expr3 | "timeout" int_or_var ltac_expr3 @@ -1456,7 +1426,7 @@ simple_tactic: [ | "decompose" "sum" one_term | "decompose" "record" one_term | "absurd" one_term -| "contradiction" OPT constr_with_bindings +| "contradiction" OPT ( one_term OPT ( "with" bindings ) ) | "autorewrite" OPT "*" "with" LIST1 ident OPT clause_dft_concl OPT ( "using" ltac_expr ) | "rewrite" "*" OPT [ "->" | "<-" ] one_term OPT ( "in" ident ) OPT ( "at" occurrences OPT ( "by" ltac_expr3 ) ) | "rewrite" "*" OPT [ "->" | "<-" ] one_term "at" occurrences "in" ident OPT ( "by" ltac_expr3 ) @@ -1529,9 +1499,7 @@ simple_tactic: [ | "autounfold_one" OPT hintbases OPT ( "in" ident ) | "unify" one_term one_term OPT ( "with" ident ) | "convert_concl_no_check" one_term -| "typeclasses" "eauto" "bfs" OPT int_or_var "with" LIST1 ident -| "typeclasses" "eauto" OPT int_or_var "with" LIST1 ident -| "typeclasses" "eauto" OPT int_or_var +| "typeclasses" "eauto" OPT "bfs" OPT int_or_var OPT ( "with" LIST1 ident ) | "head_of_constr" ident one_term | "not_evar" one_term | "is_ground" one_term @@ -1540,9 +1508,9 @@ simple_tactic: [ | "progress_evars" ltac_expr | "rewrite_strat" rewstrategy OPT ( "in" ident ) | "rewrite_db" ident OPT ( "in" ident ) -| "substitute" OPT [ "->" | "<-" ] constr_with_bindings -| "setoid_rewrite" OPT [ "->" | "<-" ] constr_with_bindings OPT ( "at" occurrences ) OPT ( "in" ident ) -| "setoid_rewrite" OPT [ "->" | "<-" ] constr_with_bindings "in" ident "at" occurrences +| "substitute" OPT [ "->" | "<-" ] one_term OPT ( "with" bindings ) +| "setoid_rewrite" OPT [ "->" | "<-" ] one_term OPT ( "with" bindings ) OPT ( "at" occurrences ) OPT ( "in" ident ) +| "setoid_rewrite" OPT [ "->" | "<-" ] one_term OPT ( "with" bindings ) "in" ident "at" occurrences | "setoid_symmetry" OPT ( "in" ident ) | "setoid_reflexivity" | "setoid_transitivity" one_term @@ -1555,8 +1523,8 @@ simple_tactic: [ | "eapply" LIST1 constr_with_bindings_arg SEP "," OPT in_hyp_as | "simple" "apply" LIST1 constr_with_bindings_arg SEP "," OPT in_hyp_as | "simple" "eapply" LIST1 constr_with_bindings_arg SEP "," OPT in_hyp_as -| "elim" constr_with_bindings_arg OPT ( "using" constr_with_bindings ) -| "eelim" constr_with_bindings_arg OPT ( "using" constr_with_bindings ) +| "elim" constr_with_bindings_arg OPT ( "using" one_term OPT ( "with" bindings ) ) +| "eelim" constr_with_bindings_arg OPT ( "using" one_term OPT ( "with" bindings ) ) | "case" induction_clause_list | "ecase" induction_clause_list | "fix" ident natural OPT ( "with" LIST1 fixdecl ) @@ -1619,8 +1587,8 @@ simple_tactic: [ | "firstorder" OPT ltac_expr firstorder_rhs | "gintuition" OPT ltac_expr | "functional" "inversion" [ ident | natural ] OPT qualid (* funind plugin *) -| "functional" "induction" term OPT fun_ind_using OPT with_names (* funind plugin *) -| "soft" "functional" "induction" LIST1 one_term OPT fun_ind_using OPT with_names (* funind plugin *) +| "functional" "induction" term OPT ( "using" one_term OPT ( "with" bindings ) ) OPT ( "as" simple_intropattern ) (* funind plugin *) +| "soft" "functional" "induction" LIST1 one_term OPT ( "using" one_term OPT ( "with" bindings ) ) OPT ( "as" simple_intropattern ) (* funind plugin *) | "psatz_Z" OPT int_or_var ltac_expr | "xlia" ltac_expr (* micromega plugin *) | "xnlia" ltac_expr (* micromega plugin *) @@ -1641,8 +1609,8 @@ simple_tactic: [ | "nsatz_compute" one_term (* nsatz plugin *) | "omega" (* omega plugin *) | "protect_fv" string OPT ( "in" ident ) -| "ring_lookup" ltac_expr0 "[" LIST0 one_term "]" LIST1 one_term (* setoid_ring plugin *) -| "field_lookup" ltac_expr "[" LIST0 one_term "]" LIST1 one_term (* setoid_ring plugin *) +| "ring_lookup" ltac_expr0 "[" LIST0 one_term "]" LIST1 one_term (* ring plugin *) +| "field_lookup" ltac_expr "[" LIST0 one_term "]" LIST1 one_term (* ring plugin *) | match_key OPT "reverse" "goal" "with" OPT "|" LIST1 ( goal_pattern "=>" ltac_expr ) SEP "|" "end" | match_key ltac_expr "with" OPT "|" LIST1 ( match_pattern "=>" ltac_expr ) SEP "|" "end" | "classical_left" @@ -1663,14 +1631,14 @@ simple_tactic: [ | "zify" | "assert_fails" ltac_expr3 | "assert_succeeds" ltac_expr3 -| "field" OPT ( "[" LIST1 term "]" ) -| "field_simplify" OPT ( "[" LIST1 term "]" ) LIST1 term OPT ( "in" ident ) -| "field_simplify_eq" OPT ( "[" LIST1 term "]" ) OPT ( "in" ident ) +| "field" OPT ( "[" LIST1 one_term "]" ) +| "field_simplify" OPT ( "[" LIST1 one_term "]" ) LIST1 one_term OPT ( "in" ident ) +| "field_simplify_eq" OPT ( "[" LIST1 one_term "]" ) OPT ( "in" ident ) | "intuition" OPT ltac_expr -| "nsatz" OPT ( "with" "radicalmax" ":=" term "strategy" ":=" term "parameters" ":=" term "variables" ":=" term ) -| "psatz" term OPT int_or_var -| "ring" OPT ( "[" LIST1 term "]" ) -| "ring_simplify" OPT ( "[" LIST1 term "]" ) LIST1 term OPT ( "in" ident ) +| "nsatz" OPT ( "with" "radicalmax" ":=" one_term "strategy" ":=" one_term "parameters" ":=" one_term "variables" ":=" one_term ) +| "psatz" one_term OPT int_or_var +| "ring" OPT ( "[" LIST1 one_term "]" ) +| "ring_simplify" OPT ( "[" LIST1 one_term "]" ) LIST1 one_term OPT ( "in" ident ) | "match" ltac2_expr5 "with" OPT ltac2_branches "end" | qualid LIST1 tactic_arg ] @@ -1718,7 +1686,7 @@ induction_clause: [ ] induction_clause_list: [ -| LIST1 induction_clause SEP "," OPT ( "using" constr_with_bindings ) OPT opt_clause +| LIST1 induction_clause SEP "," OPT ( "using" one_term OPT ( "with" bindings ) ) OPT opt_clause ] auto_using: [ @@ -1764,13 +1732,8 @@ simple_intropattern_closed: [ | naming_intropattern ] -simple_binding: [ -| "(" ident ":=" term ")" -| "(" natural ":=" term ")" -] - bindings: [ -| LIST1 simple_binding +| LIST1 ( "(" [ ident | natural ] ":=" term ")" ) | LIST1 one_term ] @@ -2184,10 +2147,6 @@ cofixdecl: [ | "(" ident LIST0 simple_binder ":" term ")" ] -constr_with_bindings: [ -| one_term OPT ( "with" bindings ) -] - conversion: [ | one_term | one_term "with" one_term @@ -2200,12 +2159,8 @@ firstorder_using: [ | "using" qualid qualid LIST0 qualid ] -fun_ind_using: [ -| "using" constr_with_bindings (* funind plugin *) -] - -with_names: [ -| "as" simple_intropattern (* funind plugin *) +func_scheme_def: [ +| ident ":=" "Induction" "for" qualid "Sort" sort_family (* funind plugin *) ] occurrences: [ diff --git a/engine/termops.ml b/engine/termops.ml index 0923ab6f4b..467b269e37 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -233,13 +233,13 @@ let pr_evar_universe_context ctx = if UState.is_empty ctx then mt () else (str"UNIVERSES:"++brk(0,1)++ - h 0 (Univ.pr_universe_context_set prl (UState.context_set ctx)) ++ fnl () ++ + h (Univ.pr_universe_context_set prl (UState.context_set ctx)) ++ fnl () ++ str"ALGEBRAIC UNIVERSES:"++brk(0,1)++ - h 0 (Univ.LSet.pr prl (UState.algebraics ctx)) ++ fnl() ++ + h (Univ.LSet.pr prl (UState.algebraics ctx)) ++ fnl() ++ str"UNDEFINED UNIVERSES:"++brk(0,1)++ - h 0 (UnivSubst.pr_universe_opt_subst (UState.subst ctx)) ++ fnl() ++ + h (UnivSubst.pr_universe_opt_subst (UState.subst ctx)) ++ fnl() ++ str "WEAK CONSTRAINTS:"++brk(0,1)++ - h 0 (UState.pr_weak prl ctx) ++ fnl ()) + h (UState.pr_weak prl ctx) ++ fnl ()) let print_env_short env sigma = let print_constr = print_kconstr in @@ -316,14 +316,14 @@ let pr_evar_list env sigma l = | Some ev' -> str " (aliased to " ++ Evar.print ev' ++ str ")" in let pr (ev, evi) = - h 0 (Evar.print ev ++ + h (Evar.print ev ++ str "==" ++ pr_evar_info env sigma evi ++ pr_alias ev ++ (if evi.evar_body == Evar_empty then str " {" ++ pr_existential_key sigma ev ++ str "}" else mt ())) in - h 0 (prlist_with_sep fnl pr l) + hv 0 (prlist_with_sep fnl pr l) let to_list d = let open Evd in diff --git a/engine/uState.ml b/engine/uState.ml index 8d1584cd95..9557111cfd 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -286,6 +286,10 @@ let process_universe_constraints ctx cstrs = if not (drop_weak_constraints ()) then weak := UPairSet.add (l,r) !weak; local | UEq (l, r) -> equalize_universes l r local in + let unify_universes cst local = + if not (UGraph.type_in_type univs) then unify_universes cst local + else try unify_universes cst local with UniverseInconsistency _ -> local + in let local = UnivProblem.Set.fold unify_universes cstrs Constraint.empty in @@ -671,7 +675,7 @@ let subst_univs_context_with_def def usubst (ctx, cst) = (LSet.diff ctx def, UnivSubst.subst_univs_constraints usubst cst) let is_trivial_leq (l,d,r) = - Level.is_prop l && (d == Le || (d == Lt && Level.is_set r)) + Level.is_prop l && (d == Le || d == Lt) && Level.is_set r (* Prop < i <-> Set+1 <= i <-> Set < i *) let translate_cstr (l,d,r as cstr) = diff --git a/engine/univMinim.ml b/engine/univMinim.ml index 1c7e716fc2..4ed6e97526 100644 --- a/engine/univMinim.ml +++ b/engine/univMinim.ml @@ -292,22 +292,29 @@ let is_bound l lbound = match lbound with | UGraph.Bound.Prop -> Level.is_prop l | UGraph.Bound.Set -> Level.is_set l +(* if [is_minimal u] then constraints [u <= v] may be dropped and get + used only for set_minimization. *) +let is_minimal ~lbound u = + Level.is_sprop u || Level.is_prop u || is_bound u lbound + (* TODO check is_small/sprop *) let normalize_context_set ~lbound g ctx us algs weak = let (ctx, csts) = ContextSet.levels ctx, ContextSet.constraints ctx in (* Keep the Prop/Set <= i constraints separate for minimization *) let smallles, csts = - Constraint.partition (fun (l,d,r) -> d == Le && (is_bound l lbound || Level.is_sprop l)) csts + Constraint.partition (fun (l,d,r) -> d == Le && is_minimal ~lbound l) csts in let smallles = if get_set_minimization () then Constraint.filter (fun (l,d,r) -> LMap.mem r us && not (Level.is_sprop l)) smallles else Constraint.empty in + let smallles = Constraint.map (fun (_,_,r) -> Level.set, Le, r) smallles in let csts, partition = (* We first put constraints in a normal-form: all self-loops are collapsed to equalities. *) + let g = UGraph.initial_universes_with g in let g = LSet.fold (fun v g -> UGraph.add_universe ~lbound ~strict:false v g) - ctx UGraph.initial_universes + ctx g in let add_soft u g = if not (Level.is_small u || LSet.mem u ctx) diff --git a/gramlib/.merlin.in b/gramlib/.merlin.in new file mode 100644 index 0000000000..cf828efdb7 --- /dev/null +++ b/gramlib/.merlin.in @@ -0,0 +1,3 @@ +FLG -open Gramlib + +REC diff --git a/ide/.merlin.in b/ide/.merlin.in index b8d7953833..50816ae3f5 100644 --- a/ide/.merlin.in +++ b/ide/.merlin.in @@ -1,8 +1,10 @@ PKG unix laglgtk3 lablgtk3-sourceview3 -S utils -B utils -S protocol -B protocol +S coqide/utils +B coqide/utils +S coqide/protocol +B coqide/protocol +S coqide/ +B coqide/ REC diff --git a/ide/coqide/coq.ml b/ide/coqide/coq.ml index 038c8b91a8..1167b8199e 100644 --- a/ide/coqide/coq.ml +++ b/ide/coqide/coq.ml @@ -512,6 +512,7 @@ let hints x = eval_call (Xmlprotocol.hints x) let search flags = eval_call (Xmlprotocol.search flags) let init x = eval_call (Xmlprotocol.init x) let stop_worker x = eval_call (Xmlprotocol.stop_worker x) +let proof_diff x = eval_call (Xmlprotocol.proof_diff x) let break_coqtop coqtop workers = if coqtop.status = Busy then @@ -579,6 +580,9 @@ struct let set (type a) (opt : a t) (v : a) = Hashtbl.replace current_state (opt_name opt) (opt_data opt v) + let get (type a) (opt : a t) = + Hashtbl.find current_state (opt_name opt) + let reset () = let init_descr d = List.iter (fun o -> set o d.init) d.opts in List.iter init_descr bool_items; diff --git a/ide/coqide/coq.mli b/ide/coqide/coq.mli index 82df36c91c..aaaf14e4d0 100644 --- a/ide/coqide/coq.mli +++ b/ide/coqide/coq.mli @@ -127,6 +127,7 @@ val hints : Interface.hints_sty -> Interface.hints_rty query val mkcases : Interface.mkcases_sty -> Interface.mkcases_rty query val search : Interface.search_sty -> Interface.search_rty query val init : Interface.init_sty -> Interface.init_rty query +val proof_diff : Interface.proof_diff_sty -> Interface.proof_diff_rty query val stop_worker: Interface.stop_worker_sty-> Interface.stop_worker_rty query @@ -144,6 +145,10 @@ sig val set : 'a t -> 'a -> unit + val get : 'a t -> Interface.option_value + + val diff : string t + val printing_unfocused: unit -> bool (** [enforce] transmits to coq the current option values. diff --git a/ide/coqide/coqOps.ml b/ide/coqide/coqOps.ml index 29ea3ce9ea..97076745a3 100644 --- a/ide/coqide/coqOps.ml +++ b/ide/coqide/coqOps.ml @@ -142,6 +142,7 @@ object method handle_reset_initial : unit task method raw_coq_query : route_id:int -> next:(query_rty value -> unit task) -> string -> unit task + method proof_diff : GText.mark -> next:(Pp.t value -> unit task) -> unit task method show_goals : unit task method backtrack_last_phrase : unit task method initialize : unit task @@ -361,6 +362,27 @@ object(self) let query = Coq.query (route_id,(phrase,sid)) in Coq.bind (Coq.seq action query) next + method proof_diff where ~next : unit Coq.task = + (* todo: would be nice to ignore comments, too *) + let rec back iter = + if iter#is_start then iter + else + let c = iter#char in + if Glib.Unichar.isspace c || c = 0 then back (iter#backward_char) + else if c = int_of_char '.' then iter#backward_char + else iter in + + let where = back (buffer#get_iter_at_mark where) in + let until _ start stop = + (buffer#get_iter_at_mark stop)#compare where >= 0 && + (buffer#get_iter_at_mark start)#compare where <= 0 in + let state_id = fst @@ self#find_id until in + let diff_opt = Interface.(match Coq.PrintOpt.(get diff) with + | StringValue diffs -> diffs + | _ -> "off") in + let proof_diff = Coq.proof_diff (diff_opt, state_id) in + Coq.bind proof_diff next + method private still_valid { edit_id = id } = try ignore(Doc.find_id document (fun _ { edit_id = id1 } -> id = id1)); true with Not_found -> false diff --git a/ide/coqide/coqOps.mli b/ide/coqide/coqOps.mli index 3a4678ae9c..84911a6aa8 100644 --- a/ide/coqide/coqOps.mli +++ b/ide/coqide/coqOps.mli @@ -20,6 +20,7 @@ object method handle_reset_initial : unit task method raw_coq_query : route_id:int -> next:(query_rty value -> unit task) -> string -> unit task + method proof_diff : GText.mark -> next:(Pp.t value -> unit task) -> unit task method show_goals : unit task method backtrack_last_phrase : unit task method initialize : unit task @@ -30,7 +31,6 @@ object method get_errors : (int * string) list method get_slaves_status : int * int * string CString.Map.t - method handle_failure : handle_exn_rty -> unit task method destroy : unit -> unit diff --git a/ide/coqide/coqide.ml b/ide/coqide/coqide.ml index b66da11e7b..f9e6e74372 100644 --- a/ide/coqide/coqide.ml +++ b/ide/coqide/coqide.ml @@ -747,6 +747,24 @@ let coq_icon () = let dir = List.find chk (Minilib.coqide_data_dirs ()) in Filename.concat dir name +let show_proof_diff where sn = + sn.messages#default_route#clear; + Coq.try_grab sn.coqtop (sn.coqops#proof_diff where + ~next:(function + | Interface.Fail (_, _, err) -> + let err = if (Pp.string_of_ppcmds err) <> "No proofs to diff." then err else + Pp.str "Put the cursor over proven lines for \"Show Proof\" diffs" + in + let err = Ideutils.validate err in + sn.messages#default_route#add err; + Coq.return () + | Interface.Good diff -> + sn.messages#default_route#add diff; + Coq.return ())) + ignore + +let show_proof_diffs _ = cb_on_current_term (show_proof_diff `INSERT) () + let about _ = let dialog = GWindow.about_dialog () in let _ = dialog#connect#response ~callback:(fun _ -> dialog#destroy ()) in @@ -1103,6 +1121,8 @@ let build_ui () = radio "Set diff" 1 ~label:"Show diffs: only _added"; radio "Set removed diff" 2 ~label:"Show diffs: added and _removed"; ]; + item "Show Proof Diffs" ~label:"_Show Proof (with diffs, if set)" ~accel:(modifier_for_display#get ^ "S") + ~callback:MiscMenu.show_proof_diffs; ]; toggle_items view_menu Coq.PrintOpt.bool_items; @@ -1352,6 +1372,11 @@ let main files = this default coqtop path *) let read_coqide_args argv = + let set_debug () = + Minilib.debug := true; + Flags.debug := true; + Exninfo.record_backtrace true + in let rec filter_coqtop coqtop project_files bindings_files out = function |"-unicode-bindings" :: sfilenames :: args -> let filenames = Str.split (Str.regexp ",") sfilenames in @@ -1371,10 +1396,12 @@ let read_coqide_args argv = |"-coqtop" :: [] -> output_string stderr "Error: missing argument after -coqtop"; exit 1 |"-debug"::args -> - Minilib.debug := true; - Flags.debug := true; - Exninfo.record_backtrace true; + set_debug (); filter_coqtop coqtop project_files bindings_files ("-debug"::out) args + |"-xml-debug"::args -> + set_debug (); + Flags.xml_debug := true; + filter_coqtop coqtop project_files bindings_files ("-xml-debug"::out) args |"-coqtop-flags" :: flags :: args-> Coq.ideslave_coqtop_flags := Some flags; filter_coqtop coqtop project_files bindings_files out args diff --git a/ide/coqide/coqide_ui.ml b/ide/coqide/coqide_ui.ml index e9ff1bbba1..6540fc6fca 100644 --- a/ide/coqide/coqide_ui.ml +++ b/ide/coqide/coqide_ui.ml @@ -89,6 +89,7 @@ let init () = \n <menuitem action='Unset diff' />\ \n <menuitem action='Set diff' />\ \n <menuitem action='Set removed diff' />\ +\n <menuitem action='Show Proof Diffs' />\ \n </menu>\ \n <menu action='Navigation'>\ \n <menuitem action='Forward' />\ diff --git a/ide/coqide/fake_ide.ml b/ide/coqide/fake_ide.ml index e1736a5fe0..034f5b4e2a 100644 --- a/ide/coqide/fake_ide.ml +++ b/ide/coqide/fake_ide.ml @@ -136,7 +136,7 @@ module Parser = struct (* {{{ *) match g with | Item (s,_) -> Printf.sprintf "%s" (clean s) | Opt g -> Printf.sprintf "[%s]" (print g) - | Alt gs -> Printf.sprintf "( %s )" (String.concat " | " (List.map print gs)) + | Alt gs -> Printf.sprintf "( %s )" (String.concat "\n| " (List.map print gs)) | Seq gs -> String.concat " " (List.map print gs) let rec print_toklist = function @@ -253,6 +253,9 @@ let eval_print l coq = after_edit_at (to_id, need_unfocus) (base_eval_call (edit_at to_id) coq) | [ Tok(_,"QUERY"); Top []; Tok(_,phrase) ] -> eval_call (query (0,(phrase,tip_id()))) coq + | [ Tok(_,"PDIFF"); Tok(_,id) ] -> + let to_id, _ = get_id id in + eval_call (proof_diff ("on",to_id)) coq | [ Tok(_,"QUERY"); Top [Tok(_,id)]; Tok(_,phrase) ] -> let to_id, _ = get_id id in eval_call (query (0,(phrase, to_id))) coq @@ -282,6 +285,7 @@ let grammar = ; Seq [Item (eat_rex "FAILADD"); Item eat_phrase] ; Seq [Item (eat_rex "EDIT_AT"); Item eat_id] ; Seq [Item (eat_rex "QUERY"); Opt (Item eat_id); Item eat_phrase] + ; Seq [Item (eat_rex "PDIFF"); Item eat_id ] ; Seq [Item (eat_rex "WAIT")] ; Seq [Item (eat_rex "JOIN")] ; Seq [Item (eat_rex "GOALS")] @@ -295,12 +299,11 @@ let grammar = let read_command inc = Parser.parse grammar inc let usage () = - error (Printf.sprintf - "A fake coqide process talking to a coqtop -toploop coqidetop.\n\ - Usage: %s (file|-) [<coqtop>]\n\ - Input syntax is the following:\n%s\n" - (Filename.basename Sys.argv.(0)) - (Parser.print grammar)) + prerr_endline (Printf.sprintf "Usage: %s ( file | - ) [ \"<coqtop arguments>\" ]\n\ + Input syntax is:\n%s\n" + (Filename.basename Sys.argv.(0)) + (Parser.print grammar)); + exit 1 module Coqide = Spawn.Sync () @@ -308,14 +311,15 @@ let main = if Sys.os_type = "Unix" then Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1)); - let def_args = ["--xml_format=Ppcmds"] in let idetop_name = System.get_toplevel_path "coqidetop" in - let coqtop_args, input_file = match Sys.argv with - | [| _; f |] -> Array.of_list def_args, f - | [| _; f; ct |] -> - let ct = Str.split (Str.regexp " ") ct in - Array.of_list (def_args @ ct), f + let input_file, args = match Sys.argv with + | [| _; f |] -> f, [] + | [| _; f; args |] -> + let args = Str.split (Str.regexp " ") args in + f, args | _ -> usage () in + let def_coqtop_args = ["--xml_format=Ppcmds"] in + let coqtop_args = Array.of_list(def_coqtop_args @ args) in let inc = if input_file = "-" then stdin else open_in input_file in prerr_endline ("Running: "^idetop_name^" "^ (String.concat " " (Array.to_list coqtop_args))); diff --git a/ide/coqide/idetop.ml b/ide/coqide/idetop.ml index ad21f663e4..297dc3a706 100644 --- a/ide/coqide/idetop.ml +++ b/ide/coqide/idetop.ml @@ -367,6 +367,17 @@ let export_option_state s = { Interface.opt_value = export_option_value s.Goptions.opt_value; } +exception NotSupported of string + +let proof_diff (diff_opt, sid) = + let diff_opt = Proof_diffs.string_to_diffs diff_opt in + let doc = get_doc () in + match Stm.get_proof ~doc sid with + | None -> CErrors.user_err (Pp.str "No proofs to diff.") + | Some proof -> + let old = Stm.get_prev_proof ~doc sid in + Proof_diffs.diff_proofs ~diff_opt ?old proof + let get_options () = let table = Goptions.get_tables () in let fold key state accu = (key, export_option_state state) :: accu in @@ -455,6 +466,7 @@ let eval_call c = Interface.hints = interruptible hints; Interface.status = interruptible status; Interface.search = interruptible search; + Interface.proof_diff = interruptible proof_diff; Interface.get_options = interruptible get_options; Interface.set_options = interruptible set_options; Interface.mkcases = interruptible idetop_make_cases; @@ -479,6 +491,8 @@ let print_xml = let m = Mutex.create () in fun oc xml -> Mutex.lock m; + if !Flags.xml_debug then + Printf.printf "SENT --> %s\n%!" (Xml_printer.to_string_fmt xml); try Control.protect_sigalrm (Xml_printer.print oc) xml; Mutex.unlock m with e -> let e = Exninfo.capture e in Mutex.unlock m; Exninfo.iraise e @@ -507,7 +521,7 @@ let loop run_mode ~opts:_ state = set_doc state.doc; init_signal_handler (); catch_break := false; - let in_ch, out_ch = Spawned.get_channels () in + let in_ch, out_ch = Spawned.get_channels () in let xml_oc = Xml_printer.make (Xml_printer.TChannel out_ch) in let in_lb = Lexing.from_function (fun s len -> CThread.thread_friendly_read in_ch s ~off:0 ~len) in @@ -518,7 +532,8 @@ let loop run_mode ~opts:_ state = while not !quit do try let xml_query = Xml_parser.parse xml_ic in -(* pr_with_pid (Xml_printer.to_string_fmt xml_query); *) + if !Flags.xml_debug then + pr_with_pid (Xml_printer.to_string_fmt xml_query); let Xmlprotocol.Unknown q = Xmlprotocol.to_call xml_query in let () = pr_debug_call q in let r = eval_call q in diff --git a/ide/coqide/protocol/interface.ml b/ide/coqide/protocol/interface.ml index 646012dcaa..86a81446e8 100644 --- a/ide/coqide/protocol/interface.ml +++ b/ide/coqide/protocol/interface.ml @@ -187,6 +187,10 @@ type status_rty = status type search_sty = search_flags type search_rty = string coq_object list +(** Diffs between the proof term at a given stateid and the previous one *) +type proof_diff_sty = string * Stateid.t +type proof_diff_rty = Pp.t + (** Retrieve the list of options of the current toplevel *) type get_options_sty = unit type get_options_rty = (option_name * option_state) list @@ -252,6 +256,7 @@ type handler = { stop_worker : stop_worker_sty -> stop_worker_rty; print_ast : print_ast_sty -> print_ast_rty; annotate : annotate_sty -> annotate_rty; + proof_diff : proof_diff_sty -> proof_diff_rty; handle_exn : handle_exn_sty -> handle_exn_rty; init : init_sty -> init_rty; quit : quit_sty -> quit_rty; diff --git a/ide/coqide/protocol/serialize.ml b/ide/coqide/protocol/serialize.ml index bdbec5b30f..6a0a3d7f5d 100644 --- a/ide/coqide/protocol/serialize.ml +++ b/ide/coqide/protocol/serialize.ml @@ -35,6 +35,11 @@ let singleton = function | l -> raise (Marshal_error ("singleton",PCData ("list of length " ^ string_of_int (List.length l)))) +let empty = function + | [] -> () + | l -> raise (Marshal_error + ("empty",PCData ("list of length " ^ string_of_int (List.length l)))) + let raw_string = function | [] -> "" | [PCData s] -> s diff --git a/ide/coqide/protocol/serialize.mli b/ide/coqide/protocol/serialize.mli index 5d88defe55..9d09b81d1e 100644 --- a/ide/coqide/protocol/serialize.mli +++ b/ide/coqide/protocol/serialize.mli @@ -16,6 +16,7 @@ val massoc: string -> (string * string) list -> string val constructor: string -> string -> xml list -> xml val do_match: string -> (string -> xml list -> 'b) -> xml -> 'b val singleton: 'a list -> 'a +val empty: 'a list -> unit val raw_string: xml list -> string val of_unit: unit -> xml val to_unit: xml -> unit diff --git a/ide/coqide/protocol/xmlprotocol.ml b/ide/coqide/protocol/xmlprotocol.ml index 6cb0cec008..6a33ff8abc 100644 --- a/ide/coqide/protocol/xmlprotocol.ml +++ b/ide/coqide/protocol/xmlprotocol.ml @@ -12,7 +12,7 @@ (** WARNING: TO BE UPDATED WHEN MODIFIED! *) -let protocol_version = "20170413" +let protocol_version = "20200911" type msg_format = Richpp of int | Ppcmds let msg_format = ref (Richpp 72) @@ -43,7 +43,7 @@ let to_search_cst = do_match "search_cst" (fun s args -> match s with | "type_pattern" -> Type_Pattern (to_string (singleton args)) | "subtype_pattern" -> SubType_Pattern (to_string (singleton args)) | "in_module" -> In_Module (to_list to_string (singleton args)) - | "include_blacklist" -> Include_Blacklist + | "include_blacklist" -> empty args; Include_Blacklist | x -> raise (Marshal_error("search",PCData x))) let of_coq_object f ans = @@ -103,14 +103,14 @@ let to_routeid = function let of_routeid i = Element ("route_id",["val",string_of_int i],[]) let of_box (ppb : Pp.block_type) = let open Pp in match ppb with - | Pp_hbox i -> constructor "ppbox" "hbox" [of_int i] + | Pp_hbox -> constructor "ppbox" "hbox" [] | Pp_vbox i -> constructor "ppbox" "vbox" [of_int i] | Pp_hvbox i -> constructor "ppbox" "hvbox" [of_int i] | Pp_hovbox i -> constructor "ppbox" "hovbox" [of_int i] let to_box = let open Pp in do_match "ppbox" (fun s args -> match s with - | "hbox" -> Pp_hbox (to_int (singleton args)) + | "hbox" -> empty args; Pp_hbox | "vbox" -> Pp_vbox (to_int (singleton args)) | "hvbox" -> Pp_hvbox (to_int (singleton args)) | "hovbox" -> Pp_hovbox (to_int (singleton args)) @@ -132,7 +132,7 @@ let rec of_pp (pp : Pp.t) = let open Pp in match Pp.repr pp with let rec to_pp xpp = let open Pp in Pp.unrepr @@ do_match "ppdoc" (fun s args -> match s with - | "empty" -> Ppcmd_empty + | "empty" -> empty args; Ppcmd_empty | "string" -> Ppcmd_string (to_string (singleton args)) | "glue" -> Ppcmd_glue (to_list to_pp (singleton args)) | "box" -> let (bt,s) = to_pair to_box to_pp (singleton args) in @@ -278,6 +278,7 @@ module ReifType : sig val state_id_t : state_id val_t val route_id_t : route_id val_t val search_cst_t : search_constraint val_t + val pp_t : Pp.t val_t val of_value_type : 'a val_t -> 'a -> xml val to_value_type : 'a val_t -> xml -> 'a @@ -314,6 +315,7 @@ end = struct | State_id : state_id val_t | Route_id : route_id val_t | Search_cst : search_constraint val_t + | Pp : Pp.t val_t type value_type = Value_type : 'a val_t -> value_type @@ -340,6 +342,7 @@ end = struct let state_id_t = State_id let route_id_t = Route_id let search_cst_t = Search_cst + let pp_t = Pp let of_value_type (ty : 'a val_t) : 'a -> xml = let rec convert : type a. a val_t -> a -> xml = function @@ -362,6 +365,7 @@ end = struct | State_id -> of_stateid | Route_id -> of_routeid | Search_cst -> of_search_cst + | Pp -> of_pp in convert ty @@ -386,6 +390,7 @@ end = struct | State_id -> to_stateid | Route_id -> to_routeid | Search_cst -> to_search_cst + | Pp -> to_pp in convert ty @@ -443,6 +448,8 @@ end = struct | In_Module s -> "In_Module " ^ String.concat "." s | Include_Blacklist -> "Include_Blacklist" + let pr_pp = Pp.string_of_ppcmds + let rec print : type a. a val_t -> a -> string = function | Unit -> pr_unit | Bool -> pr_bool @@ -463,6 +470,7 @@ end = struct | Union (t1,t2) -> (pr_union (print t1) (print t2)) | State_id -> pr_state_id | Route_id -> pr_int + | Pp -> pr_pp (* This is to break if a rename/refactoring makes the strings below outdated *) type 'a exists = bool @@ -489,6 +497,7 @@ end = struct Printf.sprintf "((%s, %s) CSig.union)" (print_val_t t1) (print_val_t t2) | State_id -> assert(true : Stateid.t exists); "Stateid.t" | Route_id -> assert(true : route_id exists); "route_id" + | Pp -> assert(true : Pp.t exists); "Pp.t" let print_type = function Value_type ty -> print_val_t ty @@ -507,6 +516,8 @@ end = struct (pr_xml (of_pair of_bool of_int (false,3))); Printf.printf "%s:\n\n%s\n\n" (print_val_t (Union (Bool,Int))) (pr_xml (of_union of_bool of_int (Inl false))); + Printf.printf "%s:\n\n%s\n\n" (print_val_t Pp) + (pr_xml (of_pp Pp.(hv 3 (str "foo" ++ spc () ++ str "bar") ))); print_endline ("All other types are records represented by a node named like the OCaml\n"^ "type which contains a flattened n-tuple. We provide one example.\n"); Printf.printf "%s:\n\n%s\n\n" (print_val_t Option_state) @@ -538,6 +549,7 @@ let interp_sty_t : interp_sty val_t = pair_t (pair_t bool_t bool_t) string_t let stop_worker_sty_t : stop_worker_sty val_t = string_t let print_ast_sty_t : print_ast_sty val_t = state_id_t let annotate_sty_t : annotate_sty val_t = string_t +let proof_diff_sty_t : proof_diff_sty val_t = pair_t string_t state_id_t let add_rty_t : add_rty val_t = pair_t state_id_t (pair_t (union_t unit_t state_id_t) string_t) @@ -563,6 +575,7 @@ let interp_rty_t : interp_rty val_t = pair_t state_id_t (union_t string_t string let stop_worker_rty_t : stop_worker_rty val_t = unit_t let print_ast_rty_t : print_ast_rty val_t = xml_t let annotate_rty_t : annotate_rty val_t = xml_t +let proof_diff_rty_t : proof_diff_rty val_t = pp_t let ($) x = erase x let calls = [| @@ -585,6 +598,7 @@ let calls = [| "StopWorker", ($)stop_worker_sty_t, ($)stop_worker_rty_t; "PrintAst", ($)print_ast_sty_t, ($)print_ast_rty_t; "Annotate", ($)annotate_sty_t, ($)annotate_rty_t; + "PDiff", ($)proof_diff_sty_t, ($)proof_diff_rty_t; |] type 'a call = @@ -609,7 +623,9 @@ type 'a call = | Interp : interp_sty -> interp_rty call | PrintAst : print_ast_sty -> print_ast_rty call | Annotate : annotate_sty -> annotate_rty call + | PDiff : proof_diff_sty -> proof_diff_rty call +(* the order of the entries must match the order in "calls" above *) let id_of_call : type a. a call -> int = function | Add _ -> 0 | Edit_at _ -> 1 @@ -630,6 +646,7 @@ let id_of_call : type a. a call -> int = function | StopWorker _ -> 16 | PrintAst _ -> 17 | Annotate _ -> 18 + | PDiff _ -> 19 let str_of_call c = pi1 calls.(id_of_call c) @@ -652,8 +669,9 @@ let init x : init_rty call = Init x let wait x : wait_rty call = Wait x let interp x : interp_rty call = Interp x let stop_worker x : stop_worker_rty call = StopWorker x -let print_ast x : print_ast_rty call = PrintAst x -let annotate x : annotate_rty call = Annotate x +let print_ast x : print_ast_rty call = PrintAst x +let annotate x : annotate_rty call = Annotate x +let proof_diff x : proof_diff_rty call = PDiff x let abstract_eval_call : type a. _ -> a call -> a value = fun handler c -> let mkGood : type a. a -> a value = fun x -> Good x in @@ -678,6 +696,7 @@ let abstract_eval_call : type a. _ -> a call -> a value = fun handler c -> | StopWorker x -> mkGood (handler.stop_worker x) | PrintAst x -> mkGood (handler.print_ast x) | Annotate x -> mkGood (handler.annotate x) + | PDiff x -> mkGood (handler.proof_diff x) with any -> let any = Exninfo.capture any in Fail (handler.handle_exn any) @@ -703,6 +722,7 @@ let of_answer : type a. a call -> a value -> xml = function | StopWorker _ -> of_value (of_value_type stop_worker_rty_t) | PrintAst _ -> of_value (of_value_type print_ast_rty_t ) | Annotate _ -> of_value (of_value_type annotate_rty_t ) + | PDiff _ -> of_value (of_value_type proof_diff_rty_t ) let of_answer msg_fmt = msg_format := msg_fmt; of_answer @@ -727,6 +747,7 @@ let to_answer : type a. a call -> xml -> a value = function | StopWorker _ -> to_value (to_value_type stop_worker_rty_t) | PrintAst _ -> to_value (to_value_type print_ast_rty_t ) | Annotate _ -> to_value (to_value_type annotate_rty_t ) + | PDiff _ -> to_value (to_value_type proof_diff_rty_t ) let of_call : type a. a call -> xml = fun q -> let mkCall x = constructor "call" (str_of_call q) [x] in @@ -750,6 +771,7 @@ let of_call : type a. a call -> xml = fun q -> | StopWorker x -> mkCall (of_value_type stop_worker_sty_t x) | PrintAst x -> mkCall (of_value_type print_ast_sty_t x) | Annotate x -> mkCall (of_value_type annotate_sty_t x) + | PDiff x -> mkCall (of_value_type proof_diff_sty_t x) let to_call : xml -> unknown_call = do_match "call" (fun s a -> @@ -774,6 +796,7 @@ let to_call : xml -> unknown_call = | "StopWorker" -> Unknown (StopWorker (mkCallArg stop_worker_sty_t a)) | "PrintAst" -> Unknown (PrintAst (mkCallArg print_ast_sty_t a)) | "Annotate" -> Unknown (Annotate (mkCallArg annotate_sty_t a)) + | "PDiff" -> Unknown (PDiff (mkCallArg proof_diff_sty_t a)) | x -> raise (Marshal_error("call",PCData x))) (** Debug printing *) @@ -805,6 +828,7 @@ let pr_full_value : type a. a call -> a value -> string = fun call value -> matc | StopWorker _ -> pr_value_gen (print stop_worker_rty_t) value | PrintAst _ -> pr_value_gen (print print_ast_rty_t ) value | Annotate _ -> pr_value_gen (print annotate_rty_t ) value + | PDiff _ -> pr_value_gen (print proof_diff_rty_t ) value let pr_call : type a. a call -> string = fun call -> let return what x = str_of_call call ^ " " ^ print what x in match call with @@ -827,6 +851,7 @@ let pr_call : type a. a call -> string = fun call -> | StopWorker x -> return stop_worker_sty_t x | PrintAst x -> return print_ast_sty_t x | Annotate x -> return annotate_sty_t x + | PDiff x -> return proof_diff_sty_t x let document to_string_fmt = Printf.printf "=== Available calls ===\n\n"; @@ -858,11 +883,11 @@ let of_message_level = function | Error -> Serialize.constructor "message_level" "error" [] let to_message_level = Serialize.do_match "message_level" (fun s args -> match s with - | "debug" -> Debug - | "info" -> Info - | "notice" -> Notice - | "warning" -> Warning - | "error" -> Error + | "debug" -> empty args; Debug + | "info" -> empty args; Info + | "notice" -> empty args; Notice + | "warning" -> empty args; Warning + | "error" -> empty args; Error | x -> raise Serialize.(Marshal_error("error level",PCData x))) let of_message lvl loc msg = diff --git a/ide/coqide/protocol/xmlprotocol.mli b/ide/coqide/protocol/xmlprotocol.mli index 44584d44d7..4dc05c18a9 100644 --- a/ide/coqide/protocol/xmlprotocol.mli +++ b/ide/coqide/protocol/xmlprotocol.mli @@ -37,6 +37,7 @@ val wait : wait_sty -> wait_rty call val interp : interp_sty -> interp_rty call val print_ast : print_ast_sty -> print_ast_rty call val annotate : annotate_sty -> annotate_rty call +val proof_diff : proof_diff_sty -> proof_diff_rty call val abstract_eval_call : handler -> 'a call -> 'a value diff --git a/interp/constrexpr.ml b/interp/constrexpr.ml index c98e05370e..d14d156ffc 100644 --- a/interp/constrexpr.ml +++ b/interp/constrexpr.ml @@ -108,7 +108,7 @@ and constr_expr_r = * constr_expr * constr_expr | CHole of Evar_kinds.t option * Namegen.intro_pattern_naming_expr * Genarg.raw_generic_argument option | CPatVar of Pattern.patvar - | CEvar of Glob_term.existential_name * (Id.t * constr_expr) list + | CEvar of Glob_term.existential_name CAst.t * (lident * constr_expr) list | CSort of Glob_term.glob_sort | CCast of constr_expr * constr_expr Glob_term.cast_type | CNotation of notation_with_optional_scope option * notation * constr_notation_substitution diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml index ce8e7d3c2c..7075d082ee 100644 --- a/interp/constrexpr_ops.ml +++ b/interp/constrexpr_ops.ml @@ -156,7 +156,7 @@ let rec constr_expr_eq e1 e2 = | CPatVar i1, CPatVar i2 -> Id.equal i1 i2 | CEvar (id1, c1), CEvar (id2, c2) -> - Id.equal id1 id2 && List.equal instance_eq c1 c2 + Id.equal id1.CAst.v id2.CAst.v && List.equal instance_eq c1 c2 | CSort s1, CSort s2 -> Glob_ops.glob_sort_eq s1 s2 | CCast(t1,c1), CCast(t2,c2) -> @@ -235,7 +235,7 @@ and constr_notation_substitution_eq (e1, el1, b1, bl1) (e2, el2, b2, bl2) = List.equal (List.equal local_binder_eq) bl1 bl2 and instance_eq (x1,c1) (x2,c2) = - Id.equal x1 x2 && constr_expr_eq c1 c2 + Id.equal x1.CAst.v x2.CAst.v && constr_expr_eq c1 c2 and cast_expr_eq c1 c2 = match c1, c2 with | CastConv t1, CastConv t2 diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 43fef8685d..7bf1c58148 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -551,7 +551,7 @@ and extern_notation_pattern allscopes vars t = function | [] -> raise No_match | (keyrule,pat,n as _rule)::rules -> try - if is_inactive_rule keyrule then raise No_match; + if is_inactive_rule keyrule || is_printing_inactive_rule keyrule pat then raise No_match; let loc = t.loc in match DAst.get t with | PatCstr (cstr,args,na) -> @@ -568,7 +568,7 @@ let rec extern_notation_ind_pattern allscopes vars ind args = function | [] -> raise No_match | (keyrule,pat,n as _rule)::rules -> try - if is_inactive_rule keyrule then raise No_match; + if is_inactive_rule keyrule || is_printing_inactive_rule keyrule pat then raise No_match; apply_notation_to_pattern (GlobRef.IndRef ind) (match_notation_constr_ind_pattern ind args pat) allscopes vars keyrule with @@ -978,7 +978,7 @@ let rec extern inctx ?impargs scopes vars r = if !print_meta_as_hole then CHole (None, IntroAnonymous, None) else (match kind with | Evar_kinds.SecondOrderPatVar n -> CPatVar n - | Evar_kinds.FirstOrderPatVar n -> CEvar (n,[])) + | Evar_kinds.FirstOrderPatVar n -> CEvar (CAst.make n,[])) | GApp (f,args) -> (match DAst.get f with @@ -1103,7 +1103,7 @@ let rec extern inctx ?impargs scopes vars r = | GFloat f -> extern_float f (snd scopes) | GArray(u,t,def,ty) -> - CArray(u,Array.map (extern inctx scopes vars) t, extern inctx scopes vars def, extern_typ scopes vars ty) + CArray(extern_universes u,Array.map (extern inctx scopes vars) t, extern inctx scopes vars def, extern_typ scopes vars ty) in insert_entry_coercion coercion (CAst.make ?loc c) @@ -1238,7 +1238,7 @@ and extern_notation inctx (custom,scopes as allscopes) vars t rules = | (keyrule,pat,n as _rule)::rules -> let loc = Glob_ops.loc_of_glob_constr t in try - if is_inactive_rule keyrule then raise No_match; + if is_inactive_rule keyrule || is_printing_inactive_rule keyrule pat then raise No_match; let f,args = match DAst.get t with | GApp (f,args) -> f,args @@ -1391,7 +1391,7 @@ let rec glob_of_pat avoid env sigma pat = DAst.make @@ match pat with | None -> Id.of_string "__" | Some id -> id in - GEvar (id,List.map (on_snd (glob_of_pat avoid env sigma)) l) + GEvar (CAst.make id,List.map (fun (id,c) -> (CAst.make id, glob_of_pat avoid env sigma c)) l) | PRel n -> let id = try match lookup_name_of_rel n env with | Name id -> id diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 48fb4a4a5d..959b61a3d7 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -2188,7 +2188,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = GPatVar (Evar_kinds.SecondOrderPatVar n) | CEvar (n, []) when pattern_mode -> DAst.make ?loc @@ - GPatVar (Evar_kinds.FirstOrderPatVar n) + GPatVar (Evar_kinds.FirstOrderPatVar n.CAst.v) (* end *) (* Parsing existential variables *) | CEvar (n, l) -> diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml index 4016a3600e..2853eef5c5 100644 --- a/interp/implicit_quantifiers.ml +++ b/interp/implicit_quantifiers.ml @@ -122,15 +122,24 @@ let next_name_away_from na avoid = | Anonymous -> make_fresh avoid (Global.env ()) (Id.of_string "anon") | Name id -> make_fresh avoid (Global.env ()) id +let rec is_class_arg c = + let open Constr in + match kind c with + | Prod (_,_,c) + | Cast (c,_,_) + | LetIn (_,_,_,c) -> is_class_arg c + | _ -> + let c, _ = decompose_appvect c in + match destRef c with + | exception DestKO -> false + | r, _ -> is_class r + let combine_params avoid applied needed = let named, applied = List.partition (function (t, Some {CAst.loc;v=ExplByName id}) -> - let is_id (_, decl) = match RelDecl.get_name decl with - | Name id' -> Id.equal id id' - | Anonymous -> false - in + let is_id decl = Name.equal (Name id) (RelDecl.get_name decl) in if not (List.exists is_id needed) then user_err ?loc (str "Wrong argument name: " ++ Id.print id); true @@ -141,27 +150,27 @@ let combine_params avoid applied needed = named in let rec aux ids avoid app need = - match app, need with - - | _, (_, LocalDef _) :: need -> aux ids avoid app need - - | [], [] -> List.rev ids, avoid + match need with + | [] -> begin match app with + | [] -> List.rev ids, avoid + | (x, _) :: _ -> user_err ?loc:(Constrexpr_ops.constr_loc x) (str "Typeclass does not expect more arguments") + end - | app, (_, (LocalAssum ({binder_name=Name id}, _))) :: need when Id.List.mem_assoc id named -> - aux (Id.List.assoc id named :: ids) avoid app need + | LocalDef _ :: need -> aux ids avoid app need - | (x, None) :: app, (None, (LocalAssum ({binder_name=Name id}, _))) :: need -> - aux (x :: ids) avoid app need - | x :: app, (None, _) :: need -> aux (fst x :: ids) avoid app need + | LocalAssum ({binder_name=Name id}, _) :: need when Id.List.mem_assoc id named -> + aux (Id.List.assoc id named :: ids) avoid app need - | _, (Some _, decl) :: need | [], (None, decl) :: need -> - let id' = next_name_away_from (RelDecl.get_name decl) avoid in - let t' = CAst.make @@ CRef (qualid_of_ident id',None) in - aux (t' :: ids) (Id.Set.add id' avoid) app need + | decl :: need -> + begin match app, is_class_arg (get_type decl) with + | (x, _) :: app, false -> aux (x :: ids) avoid app need - | (x,_) :: _, [] -> - user_err ?loc:(Constrexpr_ops.constr_loc x) (str "Typeclass does not expect more arguments") + | [], false | _, true -> + let id' = next_name_away_from (RelDecl.get_name decl) avoid in + let t' = CAst.make @@ CRef (qualid_of_ident id',None) in + aux (t' :: ids) (Id.Set.add id' avoid) app need + end in aux [] avoid applied needed @@ -190,9 +199,7 @@ let implicit_application env ty = let env = Global.env () in let sigma = Evd.from_env env in let c = class_info env sigma gr in - let (ci, rd) = c.cl_context in - let pars = List.rev (List.combine ci rd) in - let args, avoid = combine_params avoid par pars in + let args, avoid = combine_params avoid par (List.rev c.cl_context) in CAst.make ?loc @@ CAppExpl ((None, id, inst), args), avoid let warn_ignoring_implicit_status = diff --git a/interp/notation.ml b/interp/notation.ml index 7e90e15b72..d57c4f3abf 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -58,6 +58,31 @@ let notation_with_optional_scope_eq inscope1 inscope2 = match (inscope1,inscope2 let notation_eq (from1,ntn1) (from2,ntn2) = notation_entry_eq from1 from2 && String.equal ntn1 ntn2 +let pair_eq f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2 + +let notation_binder_source_eq s1 s2 = match s1, s2 with +| NtnParsedAsIdent, NtnParsedAsIdent -> true +| NtnParsedAsPattern b1, NtnParsedAsPattern b2 -> b1 = b2 +| NtnBinderParsedAsConstr bk1, NtnBinderParsedAsConstr bk2 -> bk1 = bk2 +| (NtnParsedAsIdent | NtnParsedAsPattern _ | NtnBinderParsedAsConstr _), _ -> false + +let ntpe_eq t1 t2 = match t1, t2 with +| NtnTypeConstr, NtnTypeConstr -> true +| NtnTypeBinder s1, NtnTypeBinder s2 -> notation_binder_source_eq s1 s2 +| NtnTypeConstrList, NtnTypeConstrList -> true +| NtnTypeBinderList, NtnTypeBinderList -> true +| (NtnTypeConstr | NtnTypeBinder _ | NtnTypeConstrList | NtnTypeBinderList), _ -> false + +let var_attributes_eq (_, ((entry1, sc1), tp1)) (_, ((entry2, sc2), tp2)) = + notation_entry_level_eq entry1 entry2 && + pair_eq (Option.equal String.equal) (List.equal String.equal) sc1 sc2 && + ntpe_eq tp1 tp2 + +let interpretation_eq (vars1, t1 as x1) (vars2, t2 as x2) = + x1 == x2 || + List.equal var_attributes_eq vars1 vars2 && + Notation_ops.eq_notation_constr (List.map fst vars1, List.map fst vars2) t1 t2 + let pr_notation (from,ntn) = qstring ntn ++ match from with InConstrEntry -> mt () | InCustomEntry s -> str " in custom " ++ str s module NotationOrd = @@ -90,8 +115,21 @@ type notation_data = { not_deprecation : Deprecation.t option; } +type activation = bool + +type extra_printing_notation_data = + (activation * notation_data) list + +type parsing_notation_data = + | NoParsingData + | OnlyParsingData of activation * notation_data + | ParsingAndPrintingData of + activation (* for parsing*) * + activation (* for printing *) * + notation_data (* common data for both *) + type scope = { - notations: notation_data NotationMap.t; + notations: (parsing_notation_data * extra_printing_notation_data) NotationMap.t; delimiters: delimiters option } @@ -300,10 +338,19 @@ type notation_applicative_status = type notation_rule = interp_rule * interpretation * notation_applicative_status +let notation_rule_eq (rule1,pat1,s1 as x1) (rule2,pat2,s2 as x2) = + x1 == x2 || (rule1 = rule2 && interpretation_eq pat1 pat2 && s1 = s2) + let keymap_add key interp map = let old = try KeyMap.find key map with Not_found -> [] in + (* In case of re-import, no need to keep the previous copy *) + let old = try List.remove_first (notation_rule_eq interp) old with Not_found -> old in KeyMap.add key (interp :: old) map +let keymap_remove key interp map = + let old = try KeyMap.find key map with Not_found -> [] in + KeyMap.add key (List.remove_first (notation_rule_eq interp) old) map + let keymap_find key map = try KeyMap.find key map with Not_found -> [] @@ -1225,40 +1272,90 @@ let rec find_without_delimiters find (ntn_scope,ntn) = function (* The mapping between notations and their interpretation *) +let pr_optional_scope = function + | LastLonelyNotation -> mt () + | NotationInScope scope -> spc () ++ strbrk "in scope" ++ spc () ++ str scope + let warn_notation_overridden = CWarnings.create ~name:"notation-overridden" ~category:"parsing" - (fun (ntn,which_scope) -> + (fun (scope,ntn) -> str "Notation" ++ spc () ++ pr_notation ntn ++ spc () - ++ strbrk "was already used" ++ which_scope ++ str ".") + ++ strbrk "was already used" ++ pr_optional_scope scope ++ str ".") -let declare_notation_interpretation ntn scopt pat df ~onlyprint deprecation = - let scope = match scopt with Some s -> s | None -> default_scope in - let sc = find_scope scope in - if not onlyprint then begin - let () = - if NotationMap.mem ntn sc.notations then - let which_scope = match scopt with - | None -> mt () - | Some _ -> spc () ++ strbrk "in scope" ++ spc () ++ str scope in - warn_notation_overridden (ntn,which_scope) - in - let notdata = { - not_interp = pat; - not_location = df; - not_deprecation = deprecation; - } in - let sc = { sc with notations = NotationMap.add ntn notdata sc.notations } in - scope_map := String.Map.add scope sc !scope_map - end; - begin match scopt with - | None -> scope_stack := LonelyNotationItem ntn :: !scope_stack - | Some _ -> () - end +let warn_deprecation_overridden = + CWarnings.create ~name:"notation-overridden" ~category:"parsing" + (fun ((scope,ntn),old,now) -> + match old, now with + | None, None -> assert false + | None, Some _ -> + (str "Notation" ++ spc () ++ pr_notation ntn ++ pr_optional_scope scope ++ spc () + ++ strbrk "is now marked as deprecated" ++ str ".") + | Some _, None -> + (str "Cancelling previous deprecation of notation" ++ spc () ++ + pr_notation ntn ++ pr_optional_scope scope ++ str ".") + | Some _, Some _ -> + (str "Amending deprecation of notation" ++ spc () ++ + pr_notation ntn ++ pr_optional_scope scope ++ str ".")) + +type notation_use = + | OnlyPrinting + | OnlyParsing + | ParsingAndPrinting + +let warn_override_if_needed (scopt,ntn) overridden data old_data = + if overridden then warn_notation_overridden (scopt,ntn) + else + if data.not_deprecation <> old_data.not_deprecation then + warn_deprecation_overridden ((scopt,ntn),old_data.not_deprecation,data.not_deprecation) + +let check_parsing_override (scopt,ntn) data = function + | OnlyParsingData (_,old_data) -> + let overridden = not (interpretation_eq data.not_interp old_data.not_interp) in + warn_override_if_needed (scopt,ntn) overridden data old_data; + None, not overridden + | ParsingAndPrintingData (_,on_printing,old_data) -> + let overridden = not (interpretation_eq data.not_interp old_data.not_interp) in + warn_override_if_needed (scopt,ntn) overridden data old_data; + (if on_printing then Some old_data.not_interp else None), not overridden + | NoParsingData -> None, false + +let check_printing_override (scopt,ntn) data parsingdata printingdata = + let parsing_update = match parsingdata with + | OnlyParsingData _ | NoParsingData -> parsingdata + | ParsingAndPrintingData (_,on_printing,old_data) -> + let overridden = not (interpretation_eq data.not_interp old_data.not_interp) in + warn_override_if_needed (scopt,ntn) overridden data old_data; + if overridden then NoParsingData else parsingdata in + let exists = List.exists (fun (on_printing,old_data) -> + let exists = interpretation_eq data.not_interp old_data.not_interp in + if exists && data.not_deprecation <> old_data.not_deprecation then + warn_deprecation_overridden ((scopt,ntn),old_data.not_deprecation,data.not_deprecation); + exists) printingdata in + parsing_update, exists + +let remove_uninterpretation rule (metas,c as pat) = + let (key,n) = notation_constr_key c in + notations_key_table := keymap_remove key (rule,pat,n) !notations_key_table let declare_uninterpretation rule (metas,c as pat) = let (key,n) = notation_constr_key c in notations_key_table := keymap_add key (rule,pat,n) !notations_key_table +let update_notation_data (scopt,ntn) use data table = + let (parsingdata,printingdata) = + try NotationMap.find ntn table with Not_found -> (NoParsingData, []) in + match use with + | OnlyParsing -> + let printing_update, exists = check_parsing_override (scopt,ntn) data parsingdata in + NotationMap.add ntn (OnlyParsingData (true,data), printingdata) table, printing_update, exists + | ParsingAndPrinting -> + let printing_update, exists = check_parsing_override (scopt,ntn) data parsingdata in + NotationMap.add ntn (ParsingAndPrintingData (true,true,data), printingdata) table, printing_update, exists + | OnlyPrinting -> + let parsingdata, exists = check_printing_override (scopt,ntn) data parsingdata printingdata in + let printingdata = if exists then printingdata else (true,data) :: printingdata in + NotationMap.add ntn (parsingdata, printingdata) table, None, exists + let rec find_interpretation ntn find = function | [] -> raise Not_found | OpenScopeItem scope :: scopes -> @@ -1273,7 +1370,9 @@ let rec find_interpretation ntn find = function find_interpretation ntn find scopes let find_notation ntn sc = - NotationMap.find ntn (find_scope sc).notations + match fst (NotationMap.find ntn (find_scope sc).notations) with + | OnlyParsingData (true,data) | ParsingAndPrintingData (true,_,data) -> data + | _ -> raise Not_found let notation_of_prim_token = function | Constrexpr.Numeral (SPlus,n) -> InConstrEntry, NumTok.Unsigned.sprint n @@ -1358,10 +1457,37 @@ let uninterp_cases_pattern_notations c = let uninterp_ind_pattern_notations ind = keymap_find (RefKey (canonical_gr (GlobRef.IndRef ind))) !notations_key_table +let has_active_parsing_rule_in_scope ntn sc = + try + match NotationMap.find ntn (String.Map.find sc !scope_map).notations with + | OnlyParsingData (active,_),_ | ParsingAndPrintingData (active,_,_),_ -> active + | _ -> false + with Not_found -> false + +let is_printing_active_in_scope (scope,ntn) pat = + let sc = match scope with NotationInScope sc -> sc | LastLonelyNotation -> default_scope in + let is_active extra = + try + let (_,(active,_)) = List.extract_first (fun (active,d) -> interpretation_eq d.not_interp pat) extra in + active + with Not_found -> false in + try + match NotationMap.find ntn (String.Map.find sc !scope_map).notations with + | ParsingAndPrintingData (_,active,d), extra -> + if interpretation_eq d.not_interp pat then active + else is_active extra + | _, extra -> is_active extra + with Not_found -> false + +let is_printing_inactive_rule rule pat = + match rule with + | NotationRule (scope,ntn) -> + not (is_printing_active_in_scope (scope,ntn) pat) + | SynDefRule kn -> + try let _ = Nametab.path_of_syndef kn in false with Not_found -> true + let availability_of_notation (ntn_scope,ntn) scopes = - let f scope = - NotationMap.mem ntn (String.Map.find scope !scope_map).notations in - find_without_delimiters f (ntn_scope,Some ntn) (make_current_scopes scopes) + find_without_delimiters (has_active_parsing_rule_in_scope ntn) (ntn_scope,Some ntn) (make_current_scopes scopes) (* We support coercions from a custom entry at some level to an entry at some level (possibly the same), and from and to the constr entry. E.g.: @@ -1484,6 +1610,49 @@ let entry_has_ident = function | InCustomEntryLevel (s,n) -> try String.Map.find s !entry_has_ident_map <= n with Not_found -> false +type entry_coercion_kind = + | IsEntryCoercion of notation_entry_level + | IsEntryGlobal of string * int + | IsEntryIdent of string * int + +let declare_notation (scopt,ntn) pat df ~use coe deprecation = + (* Register the interpretation *) + let scope = match scopt with NotationInScope s -> s | LastLonelyNotation -> default_scope in + let sc = find_scope scope in + let notdata = { + not_interp = pat; + not_location = df; + not_deprecation = deprecation; + } in + let notation_update,printing_update, exists = update_notation_data (scopt,ntn) use notdata sc.notations in + if not exists then + let sc = { sc with notations = notation_update } in + scope_map := String.Map.add scope sc !scope_map; + (* Update the uninterpretation cache *) + begin match printing_update with + | Some pat -> remove_uninterpretation (NotationRule (scopt,ntn)) pat + | None -> () + end; + if not exists && use <> OnlyParsing then declare_uninterpretation (NotationRule (scopt,ntn)) pat; + (* Register visibility of lonely notations *) + if not exists then begin match scopt with + | LastLonelyNotation -> scope_stack := LonelyNotationItem ntn :: !scope_stack + | NotationInScope _ -> () + end; + (* Declare a possible coercion *) + if not exists then begin match coe with + | Some (IsEntryCoercion entry) -> + let (_,level,_) = level_of_notation ntn in + let level = match fst ntn with + | InConstrEntry -> None + | InCustomEntry _ -> Some level + in + declare_entry_coercion (scopt,ntn) level entry + | Some (IsEntryGlobal (entry,n)) -> declare_custom_entry_has_global entry n + | Some (IsEntryIdent (entry,n)) -> declare_custom_entry_has_ident entry n + | None -> () + end + let availability_of_prim_token n printer_scope local_scopes = let f scope = try @@ -1561,38 +1730,6 @@ let uninterp_prim_token_cases_pattern c local_scopes = (* Miscellaneous *) -let pair_eq f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2 - -let notation_binder_source_eq s1 s2 = match s1, s2 with -| NtnParsedAsIdent, NtnParsedAsIdent -> true -| NtnParsedAsPattern b1, NtnParsedAsPattern b2 -> b1 = b2 -| NtnBinderParsedAsConstr bk1, NtnBinderParsedAsConstr bk2 -> bk1 = bk2 -| (NtnParsedAsIdent | NtnParsedAsPattern _ | NtnBinderParsedAsConstr _), _ -> false - -let ntpe_eq t1 t2 = match t1, t2 with -| NtnTypeConstr, NtnTypeConstr -> true -| NtnTypeBinder s1, NtnTypeBinder s2 -> notation_binder_source_eq s1 s2 -| NtnTypeConstrList, NtnTypeConstrList -> true -| NtnTypeBinderList, NtnTypeBinderList -> true -| (NtnTypeConstr | NtnTypeBinder _ | NtnTypeConstrList | NtnTypeBinderList), _ -> false - -let var_attributes_eq (_, ((entry1, sc1), tp1)) (_, ((entry2, sc2), tp2)) = - notation_entry_level_eq entry1 entry2 && - pair_eq (Option.equal String.equal) (List.equal String.equal) sc1 sc2 && - ntpe_eq tp1 tp2 - -let interpretation_eq (vars1, t1) (vars2, t2) = - List.equal var_attributes_eq vars1 vars2 && - Notation_ops.eq_notation_constr (List.map fst vars1, List.map fst vars2) t1 t2 - -let exists_notation_in_scope scopt ntn onlyprint r = - let scope = match scopt with Some s -> s | None -> default_scope in - try - let sc = String.Map.find scope !scope_map in - let n = NotationMap.find ntn sc.notations in - interpretation_eq n.not_interp r - with Not_found -> false - let isNVar_or_NHole = function NVar _ | NHole _ -> true | _ -> false (**********************************************************************) @@ -1846,38 +1983,63 @@ let pr_scope_classes sc = | _ :: ll -> let opt_s = match ll with [] -> mt () | _ -> str "es" in hov 0 (str "Bound to class" ++ opt_s ++ - spc() ++ prlist_with_sep spc pr_scope_class l) ++ fnl() + spc() ++ prlist_with_sep spc pr_scope_class l) let pr_notation_info prglob ntn c = - str "\"" ++ str ntn ++ str "\" := " ++ + str "\"" ++ str ntn ++ str "\" :=" ++ brk (1,2) ++ prglob (Notation_ops.glob_constr_of_notation_constr c) -let pr_named_scope prglob scope sc = +let pr_notation_status on_parsing on_printing = + let deactivated b = if b then [] else ["deactivated"] in + let l = match on_parsing, on_printing with + | Some on, None -> "only parsing" :: deactivated on + | None, Some on -> "only printing" :: deactivated on + | Some false, Some false -> ["deactivated"] + | Some true, Some false -> ["deactivated for printing"] + | Some false, Some true -> ["deactivated for parsing"] + | Some true, Some true -> [] + | None, None -> assert false in + match l with + | [] -> mt () + | l -> str "(" ++ prlist_with_sep pr_comma str l ++ str ")" + +let pr_non_empty spc pp = + if pp = mt () then mt () else spc ++ pp + +let pr_notation_data prglob (on_parsing,on_printing,{ not_interp = (_, r); not_location = (_, df) }) = + hov 0 (pr_notation_info prglob df r ++ pr_non_empty (brk(1,2)) (pr_notation_status on_parsing on_printing)) + +let extract_notation_data (main,extra) = + let main = match main with + | NoParsingData -> [] + | ParsingAndPrintingData (on_parsing, on_printing, d) -> + [Some on_parsing, Some on_printing, d] + | OnlyParsingData (on_parsing, d) -> + [Some on_parsing, None, d] in + let extra = List.map (fun (on_printing, d) -> (None, Some on_printing, d)) extra in + main @ extra + +let pr_named_scope prglob (scope,sc) = (if String.equal scope default_scope then match NotationMap.cardinal sc.notations with | 0 -> str "No lonely notation" | n -> str "Lonely notation" ++ (if Int.equal n 1 then mt() else str"s") else str "Scope " ++ str scope ++ fnl () ++ pr_delimiters_info sc.delimiters) - ++ fnl () - ++ pr_scope_classes scope - ++ NotationMap.fold - (fun ntn { not_interp = (_, r); not_location = (_, df) } strm -> - pr_notation_info prglob df r ++ fnl () ++ strm) - sc.notations (mt ()) + ++ pr_non_empty (fnl ()) (pr_scope_classes scope) + ++ prlist (fun a -> fnl () ++ pr_notation_data prglob a) + (NotationMap.fold (fun ntn data l -> extract_notation_data data @ l) sc.notations []) -let pr_scope prglob scope = pr_named_scope prglob scope (find_scope scope) +let pr_scope prglob scope = pr_named_scope prglob (scope, find_scope scope) let pr_scopes prglob = - String.Map.fold - (fun scope sc strm -> pr_named_scope prglob scope sc ++ fnl () ++ strm) - !scope_map (mt ()) + let l = String.Map.bindings !scope_map in + prlist_with_sep (fun () -> fnl () ++ fnl ()) (pr_named_scope prglob) l let rec find_default ntn = function | [] -> None | OpenScopeItem scope :: scopes -> - if NotationMap.mem ntn (find_scope scope).notations then - Some scope + if has_active_parsing_rule_in_scope ntn scope then Some scope else find_default ntn scopes | LonelyNotationItem ntn' :: scopes -> if notation_eq ntn ntn' then Some default_scope @@ -1885,12 +2047,12 @@ let rec find_default ntn = function let factorize_entries = function | [] -> [] - | (ntn,c)::l -> + | (ntn,sc',c)::l -> let (ntn,l_of_ntn,rest) = List.fold_left - (fun (a',l,rest) (a,c) -> - if notation_eq a a' then (a',c::l,rest) else (a,[c],(a',l)::rest)) - (ntn,[c],[]) l in + (fun (a',l,rest) (a,sc,c) -> + if notation_eq a a' then (a',(sc,c)::l,rest) else (a,[sc,c],(a',l)::rest)) + (ntn,[sc',c],[]) l in (ntn,l_of_ntn)::rest type symbol_token = WhiteSpace of int | String of string @@ -1961,16 +2123,18 @@ let browse_notation strict ntn map = let l = String.Map.fold (fun scope_name sc -> - NotationMap.fold (fun ntn { not_interp = (_, r); not_location = df } l -> - if List.exists (find ntn) ntns then (ntn,(scope_name,r,df))::l else l) sc.notations) + NotationMap.fold (fun ntn data l -> + if List.exists (find ntn) ntns + then List.map (fun d -> (ntn,scope_name,d)) (extract_notation_data data) @ l + else l) sc.notations) map [] in - List.sort (fun x y -> String.compare (snd (fst x)) (snd (fst y))) l + List.sort (fun x y -> String.compare (snd (pi1 x)) (snd (pi1 y))) l -let global_reference_of_notation ~head test (ntn,(sc,c,_)) = +let global_reference_of_notation ~head test (ntn,sc,(on_parsing,on_printing,{not_interp = (_,c)})) = match c with - | NRef ref when test ref -> Some (ntn,sc,ref) + | NRef ref when test ref -> Some (on_parsing,on_printing,ntn,sc,ref) | NApp (NRef ref, l) when head || List.for_all isNVar_or_NHole l && test ref -> - Some (ntn,sc,ref) + Some (on_parsing,on_printing,ntn,sc,ref) | _ -> None let error_ambiguous_notation ?loc _ntn = @@ -1990,17 +2154,17 @@ let interp_notation_as_global_reference ?loc ~head test ntn sc = let ntns = browse_notation true ntn scopes in let refs = List.map (global_reference_of_notation ~head test) ntns in match Option.List.flatten refs with - | [_,_,ref] -> ref + | [Some true,_ (* why not if the only one? *),_,_,ref] -> ref | [] -> error_notation_not_reference ?loc ntn | refs -> - let f (ntn,sc,ref) = + let f (on_parsing,_,ntn,sc,ref) = let def = find_default ntn !scope_stack in match def with | None -> false - | Some sc' -> String.equal sc sc' + | Some sc' -> on_parsing = Some true && String.equal sc sc' in match List.filter f refs with - | [_,_,ref] -> ref + | [_,_,_,_,ref] -> ref | [] -> error_notation_not_reference ?loc ntn | _ -> error_ambiguous_notation ?loc ntn @@ -2010,24 +2174,25 @@ let locate_notation prglob ntn scope = match ntns with | [] -> str "Unknown notation" | _ -> - str "Notation" ++ fnl () ++ prlist_with_sep fnl (fun (ntn,l) -> let scope = find_default ntn scopes in prlist_with_sep fnl - (fun (sc,r,(_,df)) -> + (fun (sc,(on_parsing,on_printing,{ not_interp = (_, r); not_location = (_, df) })) -> hov 0 ( + str "Notation" ++ brk (1,2) ++ pr_notation_info prglob df r ++ (if String.equal sc default_scope then mt () - else (spc () ++ str ": " ++ str sc)) ++ + else (brk (1,2) ++ str ": " ++ str sc)) ++ (if Option.equal String.equal (Some sc) scope - then spc () ++ str "(default interpretation)" else mt ()))) + then brk (1,2) ++ str "(default interpretation)" else mt ()) ++ + pr_non_empty (brk (1,2)) (pr_notation_status on_parsing on_printing))) l) ntns let collect_notation_in_scope scope sc known = assert (not (String.equal scope default_scope)); NotationMap.fold - (fun ntn { not_interp = (_, r); not_location = (_, df) } (l,known as acc) -> - if List.mem_f notation_eq ntn known then acc else ((df,r)::l,ntn::known)) + (fun ntn d (l,known as acc) -> + if List.mem_f notation_eq ntn known then acc else (extract_notation_data d @ l,ntn::known)) sc.notations ([],known) let collect_notations stack = @@ -2043,13 +2208,13 @@ let collect_notations stack = if List.mem_f notation_eq ntn knownntn then (all,knownntn) else try - let { not_interp = (_, r); not_location = (_, df) } = - NotationMap.find ntn (find_scope default_scope).notations in + let datas = extract_notation_data + (NotationMap.find ntn (find_scope default_scope).notations) in let all' = match all with | (s,lonelyntn)::rest when String.equal s default_scope -> - (s,(df,r)::lonelyntn)::rest + (s,datas@lonelyntn)::rest | _ -> - (default_scope,[df,r])::all in + (default_scope,datas)::all in (all',ntn::knownntn) with Not_found -> (* e.g. if only printing *) (all,knownntn)) ([],[]) stack) @@ -2057,7 +2222,7 @@ let collect_notations stack = let pr_visible_in_scope prglob (scope,ntns) = let strm = List.fold_right - (fun (df,r) strm -> pr_notation_info prglob df r ++ fnl () ++ strm) + (fun d strm -> pr_notation_data prglob d ++ fnl () ++ strm) ntns (mt ()) in (if String.equal scope default_scope then str "Lonely notation" ++ (match ntns with [_] -> mt () | _ -> str "s") @@ -2066,9 +2231,7 @@ let pr_visible_in_scope prglob (scope,ntns) = ++ fnl () ++ strm let pr_scope_stack prglob stack = - List.fold_left - (fun strm scntns -> strm ++ pr_visible_in_scope prglob scntns ++ fnl ()) - (mt ()) (collect_notations stack) + prlist_with_sep fnl (pr_visible_in_scope prglob) (collect_notations stack) let pr_visibility prglob = function | Some scope -> pr_scope_stack prglob (push_scope scope !scope_stack) diff --git a/interp/notation.mli b/interp/notation.mli index 948831b317..d744ff41d9 100644 --- a/interp/notation.mli +++ b/interp/notation.mli @@ -229,12 +229,24 @@ type interp_rule = | NotationRule of specific_notation | SynDefRule of KerName.t -val declare_notation_interpretation : notation -> scope_name option -> - interpretation -> notation_location -> onlyprint:bool -> - Deprecation.t option -> unit +type notation_use = + | OnlyPrinting + | OnlyParsing + | ParsingAndPrinting val declare_uninterpretation : interp_rule -> interpretation -> unit +type entry_coercion_kind = + | IsEntryCoercion of notation_entry_level + | IsEntryGlobal of string * int + | IsEntryIdent of string * int + +val declare_notation : notation_with_optional_scope * notation -> + interpretation -> notation_location -> use:notation_use -> + entry_coercion_kind option -> + Deprecation.t option -> unit + + (** Return the interpretation bound to a notation *) val interp_notation : ?loc:Loc.t -> notation -> subscopes -> interpretation * (notation_location * scope_name option) @@ -257,16 +269,14 @@ val uninterp_ind_pattern_notations : inductive -> notation_rule list val availability_of_notation : specific_notation -> subscopes -> (scope_name option * delimiters option) option +val is_printing_inactive_rule : interp_rule -> interpretation -> bool + (** {6 Miscellaneous} *) (** If head is true, also allows applied global references. *) val interp_notation_as_global_reference : ?loc:Loc.t -> head:bool -> (GlobRef.t -> bool) -> notation_key -> delimiters option -> GlobRef.t -(** Checks for already existing notations *) -val exists_notation_in_scope : scope_name option -> notation -> - bool -> interpretation -> bool - (** Declares and looks for scopes associated to arguments of a global ref *) val declare_arguments_scope : bool (** true=local *) -> GlobRef.t -> scope_name option list -> unit diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index 22531b0016..354809252e 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -27,7 +27,9 @@ open Notation_term (* helper for NVar, NVar case in eq_notation_constr *) let get_var_ndx id vs = try Some (List.index Id.equal id vs) with Not_found -> None -let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with +let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = +(vars1 == vars2 && t1 == t2) || +match t1, t2 with | NRef gr1, NRef gr2 -> GlobRef.equal gr1 gr2 | NVar id1, NVar id2 -> ( match (get_var_ndx id1 vars1,get_var_ndx id2 vars2) with diff --git a/interp/stdarg.ml b/interp/stdarg.ml index 343f85be03..70be55f843 100644 --- a/interp/stdarg.ml +++ b/interp/stdarg.ml @@ -40,8 +40,10 @@ let wit_int_or_var = let wit_ident = make0 "ident" -let wit_var = - make0 ~dyn:(val_tag (topwit wit_ident)) "var" +let wit_hyp = + make0 ~dyn:(val_tag (topwit wit_ident)) "hyp" + +let wit_var = wit_hyp let wit_ref = make0 "ref" diff --git a/interp/stdarg.mli b/interp/stdarg.mli index 3ae8b7d73f..bd34af5543 100644 --- a/interp/stdarg.mli +++ b/interp/stdarg.mli @@ -37,7 +37,10 @@ val wit_int_or_var : (int or_var, int or_var, int) genarg_type val wit_ident : Id.t uniform_genarg_type +val wit_hyp : (lident, lident, Id.t) genarg_type + val wit_var : (lident, lident, Id.t) genarg_type +[@@ocaml.deprecated "Use Stdarg.wit_hyp"] val wit_ref : (qualid, GlobRef.t located or_var, GlobRef.t) genarg_type diff --git a/kernel/cPrimitives.ml b/kernel/cPrimitives.ml index 314cb54d1d..5cd91b4e74 100644 --- a/kernel/cPrimitives.ml +++ b/kernel/cPrimitives.ml @@ -58,7 +58,6 @@ type t = | Arraydefault | Arrayset | Arraycopy - | Arrayreroot | Arraylength let parse = function @@ -110,7 +109,6 @@ let parse = function | "array_set" -> Arrayset | "array_length" -> Arraylength | "array_copy" -> Arraycopy - | "array_reroot" -> Arrayreroot | _ -> raise Not_found let equal (p1 : t) (p2 : t) = @@ -164,8 +162,7 @@ let hash = function | Arraydefault -> 45 | Arrayset -> 46 | Arraycopy -> 47 - | Arrayreroot -> 48 - | Arraylength -> 49 + | Arraylength -> 48 (* Should match names in nativevalues.ml *) let to_string = function @@ -216,7 +213,6 @@ let to_string = function | Arraydefault -> "arraydefault" | Arrayset -> "arrayset" | Arraycopy -> "arraycopy" - | Arrayreroot -> "arrayreroot" | Arraylength -> "arraylength" type const = @@ -302,7 +298,6 @@ let types = | Arraydefault -> [array_ty; PITT_param 1] | Arrayset -> [array_ty; int_ty; PITT_param 1; array_ty] | Arraycopy -> [array_ty; array_ty] - | Arrayreroot -> [array_ty; array_ty] | Arraylength -> [array_ty; int_ty] let one_param = @@ -360,7 +355,6 @@ let params = function | Arraydefault | Arrayset | Arraycopy - | Arrayreroot | Arraylength -> one_param let nparams x = List.length (params x) @@ -414,7 +408,6 @@ let univs = function | Arraydefault | Arrayset | Arraycopy - | Arrayreroot | Arraylength -> one_univ type arg_kind = diff --git a/kernel/cPrimitives.mli b/kernel/cPrimitives.mli index 41b3bff465..0db643faf4 100644 --- a/kernel/cPrimitives.mli +++ b/kernel/cPrimitives.mli @@ -56,7 +56,6 @@ type t = | Arraydefault | Arrayset | Arraycopy - | Arrayreroot | Arraylength (** Can raise [Not_found]. diff --git a/kernel/dune b/kernel/dune index ce6fdc03df..bd663974da 100644 --- a/kernel/dune +++ b/kernel/dune @@ -3,7 +3,7 @@ (synopsis "The Coq Kernel") (public_name coq.kernel) (wrapped false) - (modules (:standard \ genOpcodeFiles uint63_31 uint63_63)) + (modules (:standard \ genOpcodeFiles uint63_31 uint63_63 float64_31 float64_63)) (libraries lib byterun dynlink)) (executable @@ -19,6 +19,11 @@ (deps (:gen-file uint63_%{ocaml-config:int_size}.ml)) (action (copy# %{gen-file} %{targets}))) +(rule + (targets float64.ml) + (deps (:gen-file float64_%{ocaml-config:int_size}.ml)) + (action (copy# %{gen-file} %{targets}))) + (documentation (package coq)) diff --git a/kernel/environ.ml b/kernel/environ.ml index 03c9cb4be6..dec9e1deb8 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -274,6 +274,11 @@ let is_impredicative_sort env = function let is_impredicative_univ env u = is_impredicative_sort env (Sorts.sort_of_univ u) +let is_impredicative_family env = function + | Sorts.InSProp | Sorts.InProp -> true + | Sorts.InSet -> is_impredicative_set env + | Sorts.InType -> false + let type_in_type env = not (typing_flags env).check_universes let deactivated_guard env = not (typing_flags env).check_guarded @@ -467,14 +472,22 @@ let same_flags { [@warning "+9"] let set_cumulative_sprop b = map_universes (UGraph.set_cumulative_sprop b) +let set_type_in_type b = map_universes (UGraph.set_type_in_type b) let set_typing_flags c env = if same_flags env.env_typing_flags c then env - else set_cumulative_sprop c.cumulative_sprop { env with env_typing_flags = c } + else + let env = { env with env_typing_flags = c } in + let env = set_cumulative_sprop c.cumulative_sprop env in + let env = set_type_in_type (not c.check_universes) env in + env let set_cumulative_sprop b env = set_typing_flags {env.env_typing_flags with cumulative_sprop=b} env +let set_type_in_type b env = + set_typing_flags {env.env_typing_flags with check_universes=not b} env + let set_allow_sprop b env = { env with env_stratification = { env.env_stratification with env_sprop_allowed = b } } diff --git a/kernel/environ.mli b/kernel/environ.mli index 974e794c6b..f443ba38e1 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -122,6 +122,7 @@ val indices_matter : env -> bool val is_impredicative_sort : env -> Sorts.t -> bool val is_impredicative_univ : env -> Univ.Universe.t -> bool +val is_impredicative_family : env -> Sorts.family -> bool (** is the local context empty *) val empty_context : env -> bool @@ -320,6 +321,7 @@ val push_subgraph : Univ.ContextSet.t -> env -> env val set_engagement : engagement -> env -> env val set_typing_flags : typing_flags -> env -> env val set_cumulative_sprop : bool -> env -> env +val set_type_in_type : bool -> env -> env val set_allow_sprop : bool -> env -> env val sprop_allowed : env -> bool diff --git a/kernel/float64_31.ml b/kernel/float64_31.ml new file mode 100644 index 0000000000..09b28e6cf0 --- /dev/null +++ b/kernel/float64_31.ml @@ -0,0 +1,35 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \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) *) +(************************************************************************) + +include Float64_common + +external mul : float -> float -> float = "coq_fmul_byte" "coq_fmul" +[@@unboxed] [@@noalloc] + +external add : float -> float -> float = "coq_fadd_byte" "coq_fadd" +[@@unboxed] [@@noalloc] + +external sub : float -> float -> float = "coq_fsub_byte" "coq_fsub" +[@@unboxed] [@@noalloc] + +external div : float -> float -> float = "coq_fdiv_byte" "coq_fdiv" +[@@unboxed] [@@noalloc] + +external sqrt : float -> float = "coq_fsqrt_byte" "coq_fsqrt" +[@@unboxed] [@@noalloc] + +(*** Test at runtime that no harmful double rounding seems to + be performed with an intermediate 80 bits representation (x87). *) +let () = + let b = ldexp 1. 53 in + let s = add 1. (ldexp 1. (-52)) in + if add b s <= b || add b 1. <> b || ldexp 1. (-1074) <= 0. then + failwith "Detected non IEEE-754 compliant architecture (or wrong \ + rounding mode). Use of Float is thus unsafe." diff --git a/kernel/float64_63.ml b/kernel/float64_63.ml new file mode 100644 index 0000000000..0025531cb1 --- /dev/null +++ b/kernel/float64_63.ml @@ -0,0 +1,35 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \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) *) +(************************************************************************) + +include Float64_common + +let mul (x : float) (y : float) : float = x *. y +[@@ocaml.inline always] + +let add (x : float) (y : float) : float = x +. y +[@@ocaml.inline always] + +let sub (x : float) (y : float) : float = x -. y +[@@ocaml.inline always] + +let div (x : float) (y : float) : float = x /. y +[@@ocaml.inline always] + +let sqrt (x : float) : float = sqrt x +[@@ocaml.inline always] + +(*** Test at runtime that no harmful double rounding seems to + be performed with an intermediate 80 bits representation (x87). *) +let () = + let b = ldexp 1. 53 in + let s = add 1. (ldexp 1. (-52)) in + if add b s <= b || add b 1. <> b || ldexp 1. (-1074) <= 0. then + failwith "Detected non IEEE-754 compliant architecture (or wrong \ + rounding mode). Use of Float is thus unsafe." diff --git a/kernel/float64.ml b/kernel/float64_common.ml index 76005a3dc6..2991a20b49 100644 --- a/kernel/float64.ml +++ b/kernel/float64_common.ml @@ -88,21 +88,6 @@ let classify x = | FP_nan -> NaN [@@ocaml.inline always] -external mul : float -> float -> float = "coq_fmul_byte" "coq_fmul" -[@@unboxed] [@@noalloc] - -external add : float -> float -> float = "coq_fadd_byte" "coq_fadd" -[@@unboxed] [@@noalloc] - -external sub : float -> float -> float = "coq_fsub_byte" "coq_fsub" -[@@unboxed] [@@noalloc] - -external div : float -> float -> float = "coq_fdiv_byte" "coq_fdiv" -[@@unboxed] [@@noalloc] - -external sqrt : float -> float = "coq_fsqrt_byte" "coq_fsqrt" -[@@unboxed] [@@noalloc] - let of_int63 x = Uint63.to_float x [@@ocaml.inline always] @@ -157,12 +142,3 @@ let total_compare f1 f2 = let is_float64 t = Obj.tag t = Obj.double_tag [@@ocaml.inline always] - -(*** Test at runtime that no harmful double rounding seems to - be performed with an intermediate 80 bits representation (x87). *) -let () = - let b = ldexp 1. 53 in - let s = add 1. (ldexp 1. (-52)) in - if add b s <= b || add b 1. <> b || ldexp 1. (-1074) <= 0. then - failwith "Detected non IEEE-754 compliant architecture (or wrong \ - rounding mode). Use of Float is thus unsafe." diff --git a/kernel/float64_common.mli b/kernel/float64_common.mli new file mode 100644 index 0000000000..4fb1c114a5 --- /dev/null +++ b/kernel/float64_common.mli @@ -0,0 +1,95 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \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) *) +(************************************************************************) + +(** [t] is currently implemented by OCaml's [float] type. + +Beware: NaNs have a sign and a payload, while they should be +indistinguishable from Coq's perspective. *) +type t = float + +(** Test functions for special values to avoid calling [classify] *) +val is_nan : t -> bool +val is_infinity : t -> bool +val is_neg_infinity : t -> bool + +val of_string : string -> t + +(** Print a float exactly as an hexadecimal value (exact decimal + * printing would be possible but sometimes requires more than 700 + * digits). *) +val to_hex_string : t -> string + +(** Print a float as a decimal value. The printing is not exact (the + * real value printed is not always the given floating-point value), + * however printing is precise enough that forall float [f], + * [of_string (to_decimal_string f) = f]. *) +val to_string : t -> string + +val compile : t -> string + +val of_float : float -> t + +(** Return [true] for "-", [false] for "+". *) +val sign : t -> bool + +val opp : t -> t +val abs : t -> t + +type float_comparison = FEq | FLt | FGt | FNotComparable + +val eq : t -> t -> bool + +val lt : t -> t -> bool + +val le : t -> t -> bool + +(** The IEEE 754 float comparison. + * NotComparable is returned if there is a NaN in the arguments *) +val compare : t -> t -> float_comparison +[@@ocaml.inline always] + +type float_class = + | PNormal | NNormal | PSubn | NSubn | PZero | NZero | PInf | NInf | NaN + +val classify : t -> float_class +[@@ocaml.inline always] + +(** Link with integers *) +val of_int63 : Uint63.t -> t +[@@ocaml.inline always] + +val normfr_mantissa : t -> Uint63.t +[@@ocaml.inline always] + +(** Shifted exponent extraction *) +val eshift : int + +val frshiftexp : t -> t * Uint63.t (* float remainder, shifted exponent *) +[@@ocaml.inline always] + +val ldshiftexp : t -> Uint63.t -> t +[@@ocaml.inline always] + +val next_up : t -> t + +val next_down : t -> t + +(** Return true if two floats are equal. + * All NaN values are considered equal. *) +val equal : t -> t -> bool +[@@ocaml.inline always] + +val hash : t -> int + +(** Total order relation over float values. Behaves like [Pervasives.compare].*) +val total_compare : t -> t -> int + +val is_float64 : Obj.t -> bool +[@@ocaml.inline always] diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml index 179353d3f0..b2520b780f 100644 --- a/kernel/indTyping.ml +++ b/kernel/indTyping.ml @@ -77,7 +77,7 @@ let check_univ_leq ?(is_real_arg=false) env u info = else info in (* Inductive types provide explicit lifting from SProp to other universes, so allow SProp <= any. *) - if type_in_type env || Univ.Universe.is_sprop u || UGraph.check_leq (universes env) u ind_univ + if Univ.Universe.is_sprop u || UGraph.check_leq (universes env) u ind_univ then { info with ind_min_univ = Option.map (Universe.sup u) info.ind_min_univ } else if is_impredicative_univ env ind_univ && Option.is_empty info.ind_min_univ then { info with ind_squashed = true } diff --git a/kernel/kernel.mllib b/kernel/kernel.mllib index d4d7150222..5b2a7bd9c2 100644 --- a/kernel/kernel.mllib +++ b/kernel/kernel.mllib @@ -2,6 +2,7 @@ Names TransparentState Uint63 Parray +Float64_common Float64 Univ UGraph diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml index 5873d1f502..c7b866179b 100644 --- a/kernel/mod_typing.ml +++ b/kernel/mod_typing.ml @@ -80,12 +80,11 @@ let rec check_with_def env struc (idl,(c,ctx)) mp equiv = let j = Typeops.infer env' c in assert (j.uj_val == c); (* relevances should already be correct here *) let typ = cb.const_type in - let cst' = Reduction.infer_conv_leq env' (Environ.universes env') - j.uj_type typ in + let cst' = Reduction.infer_conv_leq env' j.uj_type typ in j.uj_val, cst' | Def cs -> let c' = Mod_subst.force_constr cs in - c, Reduction.infer_conv env' (Environ.universes env') c c' + c, Reduction.infer_conv env' c c' | Primitive _ -> error_incorrect_with_constraint lab in @@ -103,12 +102,11 @@ let rec check_with_def env struc (idl,(c,ctx)) mp equiv = let j = Typeops.infer env' c in assert (j.uj_val == c); (* relevances should already be correct here *) let typ = cb.const_type in - let cst' = Reduction.infer_conv_leq env' (Environ.universes env') - j.uj_type typ in + let cst' = Reduction.infer_conv_leq env' j.uj_type typ in cst' | Def cs -> let c' = Mod_subst.force_constr cs in - let cst' = Reduction.infer_conv env' (Environ.universes env') c c' in + let cst' = Reduction.infer_conv env' c c' in cst' | Primitive _ -> error_incorrect_with_constraint lab diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml index 01e9550ec5..fc6afb79d4 100644 --- a/kernel/nativeconv.ml +++ b/kernel/nativeconv.ml @@ -176,7 +176,7 @@ let native_conv cv_pb sigma env t1 t2 = else Constr.eq_constr_univs univs t1 t2 in if not b then - let univs = (univs, checked_universes) in + let state = (univs, checked_universes) in let t1 = Term.it_mkLambda_or_LetIn t1 (Environ.rel_context env) in let t2 = Term.it_mkLambda_or_LetIn t2 (Environ.rel_context env) in - let _ = native_conv_gen cv_pb sigma env univs t1 t2 in () + let _ = native_conv_gen cv_pb sigma env state t1 t2 in () diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml index 9e17f97a56..05c98e4b87 100644 --- a/kernel/nativevalues.ml +++ b/kernel/nativevalues.ml @@ -739,15 +739,6 @@ let arraycopy accu vA t = no_check_arraycopy t else accu vA t -let no_check_arrayreroot t = - of_parray (Parray.reroot (to_parray t)) -[@@ocaml.inline always] - -let arrayreroot accu vA t = - if is_parray t then - no_check_arrayreroot t - else accu vA t - let no_check_arraylength t = mk_uint (Parray.length (to_parray t)) [@@ocaml.inline always] diff --git a/kernel/nativevalues.mli b/kernel/nativevalues.mli index 08c5bd7126..b9b75a9d7c 100644 --- a/kernel/nativevalues.mli +++ b/kernel/nativevalues.mli @@ -344,7 +344,6 @@ val arrayget : t -> t -> t -> t -> t (* accu A t n *) val arraydefault : t -> t -> t (* accu A t *) val arrayset : t -> t -> t -> t -> t -> t (* accu A t n v *) val arraycopy : t -> t -> t -> t (* accu A t *) -val arrayreroot : t -> t -> t -> t (* accu A t *) val arraylength : t -> t -> t -> t (* accu A t *) val arrayinit : t -> t -> t -> t (* accu A n f def *) val arraymap : t -> t -> t (* accu A B f t *) @@ -364,8 +363,5 @@ val no_check_arrayset : t -> t -> t -> t val no_check_arraycopy : t -> t [@@ocaml.inline always] -val no_check_arrayreroot : t -> t -[@@ocaml.inline always] - val no_check_arraylength : t -> t [@@ocaml.inline always] diff --git a/kernel/parray.ml b/kernel/parray.ml index ea314c1883..0953f4b33f 100644 --- a/kernel/parray.ml +++ b/kernel/parray.ml @@ -27,45 +27,52 @@ and 'a kind = let unsafe_of_array t def = ref (Array (t,def)) let of_array t def = unsafe_of_array (Array.copy t) def -let rec length_int p = - match !p with - | Array (t,_) -> Array.length t - | Updated (_, _, p) -> length_int p +let rec rerootk t k = + match !t with + | Array (a, _) -> k a + | Updated (i, v, p) -> + let k' a = + let v' = Array.unsafe_get a i in + Array.unsafe_set a i v; + t := !p; (* i.e., Array (a, def) *) + p := Updated (i, v', t); + k a in + rerootk p k' + +let reroot t = rerootk t (fun a -> a) + +let length_int p = + Array.length (reroot p) let length p = Uint63.of_int @@ length_int p -let rec get p n = - match !p with - | Array (t,def) -> - let l = Array.length t in - if Uint63.le Uint63.zero n && Uint63.lt n (Uint63.of_int l) then - Array.unsafe_get t (length_to_int n) - else def - | Updated (k,e,p) -> - if Uint63.equal n (Uint63.of_int k) then e - else get p n +let get p n = + let t = reroot p in + let l = Array.length t in + if Uint63.le Uint63.zero n && Uint63.lt n (Uint63.of_int l) then + Array.unsafe_get t (length_to_int n) + else + match !p with + | Array (_, def) -> def + | Updated _ -> assert false let set p n e = - let kind = !p in - match kind with - | Array (t,_) -> - let l = Uint63.of_int @@ Array.length t in - if Uint63.le Uint63.zero n && Uint63.lt n l then - let res = ref kind in - let n = length_to_int n in - p := Updated (n, Array.unsafe_get t n, res); - Array.unsafe_set t n e; - res - else p - | Updated _ -> - if Uint63.le Uint63.zero n && Uint63.lt n (length p) then - ref (Updated((length_to_int n), e, p)) - else p - -let rec default p = + let a = reroot p in + let l = Uint63.of_int (Array.length a) in + if Uint63.le Uint63.zero n && Uint63.lt n l then + let i = length_to_int n in + let v' = Array.unsafe_get a i in + Array.unsafe_set a i e; + let t = ref !p in (* i.e., Array (a, def) *) + p := Updated (i, v', t); + t + else p + +let default p = + let _ = reroot p in match !p with | Array (_,def) -> def - | Updated (_,_,p) -> default p + | Updated _ -> assert false let make n def = ref (Array (Array.make (trunc_size n) def, def)) @@ -75,33 +82,19 @@ let init n f def = let t = Array.init n f in ref (Array (t, def)) -let rec to_array p = +let to_array p = + let _ = reroot p in match !p with | Array (t,def) -> Array.copy t, def - | Updated (n,e,p) -> - let (t,_) as r = to_array p in - Array.unsafe_set t n e; r + | Updated _ -> assert false let copy p = let (t,def) = to_array p in ref (Array (t,def)) -let rec rerootk t k = - match !t with - | Array _ -> k () - | Updated (i, v, t') -> - let k' () = - begin match !t' with - | Array (a,_def) as n -> - let v' = a.(i) in - Array.unsafe_set a i v; - t := n; - t' := Updated (i, v', t) - | Updated _ -> assert false - end; k() in - rerootk t' k' - -let reroot t = rerootk t (fun () -> t) +let reroot t = + let _ = reroot t in + t let map f p = let p = reroot p in diff --git a/kernel/parray.mli b/kernel/parray.mli index 0276278bd0..8b6565c159 100644 --- a/kernel/parray.mli +++ b/kernel/parray.mli @@ -19,7 +19,6 @@ val default : 'a t -> 'a val make : Uint63.t -> 'a -> 'a t val init : Uint63.t -> (int -> 'a) -> 'a -> 'a t val copy : 'a t -> 'a t -val reroot : 'a t -> 'a t val map : ('a -> 'b) -> 'a t -> 'b t diff --git a/kernel/primred.ml b/kernel/primred.ml index 90eeeb9be7..f158cfacea 100644 --- a/kernel/primred.ml +++ b/kernel/primred.ml @@ -365,11 +365,6 @@ struct let t = get_parray evd args 1 in let t' = Parray.copy t in E.mkArray env u t' ty - | Arrayreroot -> - let ar = E.get args 1 in - let t = E.get_parray evd ar in - let _ = Parray.reroot t in - ar | Arraylength -> let t = get_parray evd args 1 in E.mkInt env (Parray.length t) diff --git a/kernel/reduction.ml b/kernel/reduction.ml index 7c6b869b4a..96bf370342 100644 --- a/kernel/reduction.ml +++ b/kernel/reduction.ml @@ -189,7 +189,7 @@ type 'a kernel_conversion_function = env -> 'a -> 'a -> unit (* functions of this type can be called from outside the kernel *) type 'a extended_conversion_function = ?l2r:bool -> ?reds:TransparentState.t -> env -> - ?evars:((existential->constr option) * UGraph.t) -> + ?evars:(existential->constr option) -> 'a -> 'a -> unit exception NotConvertible @@ -210,9 +210,6 @@ type conv_pb = let is_cumul = function CUMUL -> true | CONV -> false type 'a universe_compare = { - (* used in reduction *) - compare_graph : 'a -> UGraph.t; - (* Might raise NotConvertible *) compare_sorts : env -> conv_pb -> Sorts.t -> Sorts.t -> 'a -> 'a; compare_instances: flex:bool -> Univ.Instance.t -> Univ.Instance.t -> 'a -> 'a; @@ -224,7 +221,7 @@ type 'a universe_state = 'a * 'a universe_compare type ('a,'b) generic_conversion_function = env -> 'b universe_state -> 'a -> 'a -> 'b -type 'a infer_conversion_function = env -> UGraph.t -> 'a -> 'a -> Univ.Constraint.t +type 'a infer_conversion_function = env -> 'a -> 'a -> Univ.Constraint.t let sort_cmp_universes env pb s0 s1 (u, check) = (check.compare_sorts env pb s0 s1 u, check) @@ -765,9 +762,8 @@ and convert_list l2r infos lft1 lft2 v1 v2 cuniv = match v1, v2 with convert_list l2r infos lft1 lft2 v1 v2 cuniv | _, _ -> raise NotConvertible -let clos_gen_conv trans cv_pb l2r evars env univs t1 t2 = +let clos_gen_conv trans cv_pb l2r evars env graph univs t1 t2 = let reds = CClosure.RedFlags.red_add_transparent betaiotazeta trans in - let graph = (snd univs).compare_graph (fst univs) in let infos = create_clos_infos ~univs:graph ~evars reds env in let infos = { cnv_inf = infos; @@ -815,8 +811,7 @@ let check_inductive_instances cv_pb variance u1 u2 univs = else raise NotConvertible let checked_universes = - { compare_graph = (fun x -> x); - compare_sorts = checked_sort_cmp_universes; + { compare_sorts = checked_sort_cmp_universes; compare_instances = check_convert_instances; compare_cumul_instances = check_inductive_instances; } @@ -878,8 +873,7 @@ let infer_inductive_instances cv_pb variance u1 u2 (univs,csts') = (univs, Univ.Constraint.union csts csts') let inferred_universes : (UGraph.t * Univ.Constraint.t) universe_compare = - { compare_graph = (fun (x,_) -> x); - compare_sorts = infer_cmp_universes; + { compare_sorts = infer_cmp_universes; compare_instances = infer_convert_instances; compare_cumul_instances = infer_inductive_instances; } @@ -890,12 +884,12 @@ let gen_conv cv_pb l2r reds env evars univs t1 t2 = in if b then () else - let _ = clos_gen_conv reds cv_pb l2r evars env (univs, checked_universes) t1 t2 in + let _ = clos_gen_conv reds cv_pb l2r evars env univs (univs, checked_universes) t1 t2 in () (* Profiling *) -let gen_conv cv_pb ?(l2r=false) ?(reds=TransparentState.full) env ?(evars=(fun _->None), universes env) = - let evars, univs = evars in +let gen_conv cv_pb ?(l2r=false) ?(reds=TransparentState.full) env ?(evars=(fun _->None)) = + let univs = Environ.universes env in if Flags.profile then let fconv_universes_key = CProfile.declare_profile "trans_fconv_universes" in CProfile.profile8 fconv_universes_key gen_conv cv_pb l2r reds env evars univs @@ -906,35 +900,37 @@ let conv = gen_conv CONV let conv_leq = gen_conv CUMUL let generic_conv cv_pb ~l2r evars reds env univs t1 t2 = + let graph = Environ.universes env in let (s, _) = - clos_gen_conv reds cv_pb l2r evars env univs t1 t2 + clos_gen_conv reds cv_pb l2r evars env graph univs t1 t2 in s -let infer_conv_universes cv_pb l2r evars reds env univs t1 t2 = +let infer_conv_universes cv_pb l2r evars reds env t1 t2 = + let univs = Environ.universes env in let b, cstrs = if cv_pb == CUMUL then Constr.leq_constr_univs_infer univs t1 t2 else Constr.eq_constr_univs_infer univs t1 t2 in if b then cstrs else - let univs = ((univs, Univ.Constraint.empty), inferred_universes) in - let ((_,cstrs), _) = clos_gen_conv reds cv_pb l2r evars env univs t1 t2 in + let state = ((univs, Univ.Constraint.empty), inferred_universes) in + let ((_,cstrs), _) = clos_gen_conv reds cv_pb l2r evars env univs state t1 t2 in cstrs (* Profiling *) let infer_conv_universes = if Flags.profile then let infer_conv_universes_key = CProfile.declare_profile "infer_conv_universes" in - CProfile.profile8 infer_conv_universes_key infer_conv_universes + CProfile.profile7 infer_conv_universes_key infer_conv_universes else infer_conv_universes let infer_conv ?(l2r=false) ?(evars=fun _ -> None) ?(ts=TransparentState.full) - env univs t1 t2 = - infer_conv_universes CONV l2r evars ts env univs t1 t2 + env t1 t2 = + infer_conv_universes CONV l2r evars ts env t1 t2 let infer_conv_leq ?(l2r=false) ?(evars=fun _ -> None) ?(ts=TransparentState.full) - env univs t1 t2 = - infer_conv_universes CUMUL l2r evars ts env univs t1 t2 + env t1 t2 = + infer_conv_universes CUMUL l2r evars ts env t1 t2 let default_conv cv_pb ?l2r:_ env t1 t2 = gen_conv cv_pb env t1 t2 diff --git a/kernel/reduction.mli b/kernel/reduction.mli index 4ae3838691..7d32596f74 100644 --- a/kernel/reduction.mli +++ b/kernel/reduction.mli @@ -31,14 +31,12 @@ exception NotConvertible type 'a kernel_conversion_function = env -> 'a -> 'a -> unit type 'a extended_conversion_function = ?l2r:bool -> ?reds:TransparentState.t -> env -> - ?evars:((existential->constr option) * UGraph.t) -> + ?evars:(existential->constr option) -> 'a -> 'a -> unit type conv_pb = CONV | CUMUL type 'a universe_compare = { - compare_graph : 'a -> UGraph.t; (* used for case inversion in reduction *) - (* Might raise NotConvertible *) compare_sorts : env -> conv_pb -> Sorts.t -> Sorts.t -> 'a -> 'a; compare_instances: flex:bool -> Univ.Instance.t -> Univ.Instance.t -> 'a -> 'a; @@ -50,7 +48,7 @@ type 'a universe_state = 'a * 'a universe_compare type ('a,'b) generic_conversion_function = env -> 'b universe_state -> 'a -> 'a -> 'b -type 'a infer_conversion_function = env -> UGraph.t -> 'a -> 'a -> Univ.Constraint.t +type 'a infer_conversion_function = env -> 'a -> 'a -> Univ.Constraint.t val get_cumulativity_constraints : conv_pb -> Univ.Variance.t array -> Univ.Instance.t -> Univ.Instance.t -> Univ.Constraint.t diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml index da77a2882e..3dee3d2b2f 100644 --- a/kernel/safe_typing.ml +++ b/kernel/safe_typing.ml @@ -79,8 +79,10 @@ module NamedDecl = Context.Named.Declaration * STRUCT (params,oldsenv) : inside a local module, with module parameters [params] and earlier environment [oldsenv] * SIG (params,oldsenv) : same for a local module type - - [modresolver] : delta_resolver concerning the module content - - [paramresolver] : delta_resolver concerning the module parameters + - [modresolver] : delta_resolver concerning the module content, that needs to + be marshalled on disk + - [paramresolver] : delta_resolver in scope but not part of the library per + se, that is from functor parameters and required libraries - [revstruct] : current module content, most recent declarations first - [modlabels] and [objlabels] : names defined in the current module, either for modules/modtypes or for constants/inductives. @@ -1301,7 +1303,9 @@ let import lib cst vodigest senv = mp, { senv with env; - modresolver = Mod_subst.add_delta_resolver mb.mod_delta senv.modresolver; + (* Do NOT store the name quotient from the dependencies in the set of + constraints that will be marshalled on disk. *) + paramresolver = Mod_subst.add_delta_resolver mb.mod_delta senv.paramresolver; required = DPmap.add lib.comp_name vodigest senv.required; loads = (mp,mb)::senv.loads; sections; diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml index 28baa82666..76a1c190be 100644 --- a/kernel/subtyping.ml +++ b/kernel/subtyping.ml @@ -85,7 +85,7 @@ let make_labmap mp list = let check_conv_error error why cst poly f env a1 a2 = try - let cst' = f env (Environ.universes env) a1 a2 in + let cst' = f env a1 a2 in if poly then if Constraint.is_empty cst' then cst else error (IncompatiblePolymorphism (env, a1, a2)) diff --git a/kernel/typeops.mli b/kernel/typeops.mli index 87a5666fcc..d381e55dd6 100644 --- a/kernel/typeops.mli +++ b/kernel/typeops.mli @@ -111,7 +111,7 @@ val type_of_global_in_context : env -> GlobRef.t -> types * Univ.AUContext.t (** {6 Miscellaneous. } *) (** Check that hyps are included in env and fails with error otherwise *) -val check_hyps_inclusion : env -> ?evars:((existential->constr option) * UGraph.t) -> +val check_hyps_inclusion : env -> ?evars:(existential->constr option) -> GlobRef.t -> Constr.named_context -> unit (** Types for primitives *) diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml index 52e93a9e22..096e458ec4 100644 --- a/kernel/uGraph.ml +++ b/kernel/uGraph.ml @@ -29,7 +29,12 @@ module G = AcyclicGraph.Make(struct code (eg add_universe with a constraint vs G.add with no constraint) *) -type t = { graph: G.t; sprop_cumulative : bool } +type t = { + graph: G.t; + sprop_cumulative : bool; + type_in_type : bool; +} + type 'a check_function = t -> 'a -> 'a -> bool let g_map f g = @@ -39,6 +44,10 @@ let g_map f g = let set_cumulative_sprop b g = {g with sprop_cumulative=b} +let set_type_in_type b g = {g with type_in_type=b} + +let type_in_type g = g.type_in_type + let check_smaller_expr g (u,n) (v,m) = let diff = n - m in match diff with @@ -55,28 +64,33 @@ let real_check_leq g u v = Universe.for_all (fun ul -> exists_bigger g ul v) u let check_leq g u v = + type_in_type g || Universe.equal u v || (g.sprop_cumulative && Universe.is_sprop u) || (not (Universe.is_sprop u) && not (Universe.is_sprop v) && (is_type0m_univ u || real_check_leq g u v)) let check_eq g u v = + type_in_type g || Universe.equal u v || (not (Universe.is_sprop u || Universe.is_sprop v) && (real_check_leq g u v && real_check_leq g v u)) let check_eq_level g u v = u == v || + type_in_type g || (not (Level.is_sprop u || Level.is_sprop v) && G.check_eq g.graph u v) -let empty_universes = {graph=G.empty; sprop_cumulative=false} +let empty_universes = {graph=G.empty; sprop_cumulative=false; type_in_type=false} let initial_universes = let big_rank = 1000000 in let g = G.empty in let g = G.add ~rank:big_rank Level.prop g in let g = G.add ~rank:big_rank Level.set g in - {graph=G.enforce_lt Level.prop Level.set g; sprop_cumulative=false} + {empty_universes with graph=G.enforce_lt Level.prop Level.set g} + +let initial_universes_with g = {g with graph=initial_universes.graph} let enforce_constraint (u,d,v) g = match d with @@ -91,6 +105,10 @@ let enforce_constraint (u,d,v as cst) g = | true, Le, false when g.sprop_cumulative -> g | _ -> raise (UniverseInconsistency (d,Universe.make u, Universe.make v, None)) +let enforce_constraint cst g = + if not (type_in_type g) then enforce_constraint cst g + else try enforce_constraint cst g with UniverseInconsistency _ -> g + let merge_constraints csts g = Constraint.fold enforce_constraint csts g let check_constraint g (u,d,v) = @@ -103,8 +121,8 @@ let check_constraint g (u,d,v as cst) = match Level.is_sprop u, d, Level.is_sprop v with | false, _, false -> check_constraint g.graph cst | true, (Eq|Le), true -> true - | true, Le, false -> g.sprop_cumulative - | _ -> false + | true, Le, false -> g.sprop_cumulative || type_in_type g + | _ -> type_in_type g let check_constraints csts g = Constraint.for_all (check_constraint g) csts @@ -145,8 +163,10 @@ let enforce_leq_alg u v g = let enforce_leq_alg u v g = match Universe.is_sprop u, Universe.is_sprop v with | true, true -> Constraint.empty, g - | true, false | false, true -> raise (UniverseInconsistency (Le, u, v, None)) | false, false -> enforce_leq_alg u v g + | left, _ -> + if left && g.sprop_cumulative then Constraint.empty, g + else raise (UniverseInconsistency (Le, u, v, None)) (* sanity check wrapper *) let enforce_leq_alg u v g = diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli index c9fbd7f694..87b3634e28 100644 --- a/kernel/uGraph.mli +++ b/kernel/uGraph.mli @@ -16,6 +16,15 @@ type t val set_cumulative_sprop : bool -> t -> t (** Makes the system incomplete. *) +val set_type_in_type : bool -> t -> t + +(** When [type_in_type], functions adding constraints do not fail and + may instead ignore inconsistent constraints. + + Checking functions such as [check_leq] always return [true]. +*) +val type_in_type : t -> bool + type 'a check_function = t -> 'a -> 'a -> bool val check_leq : Universe.t check_function @@ -25,6 +34,9 @@ val check_eq_level : Level.t check_function (** The initial graph of universes: Prop < Set *) val initial_universes : t +(** Initial universes, but keeping options such as type in type from the argument. *) +val initial_universes_with : t -> t + (** Check equality of instances w.r.t. a universe graph *) val check_eq_instances : Instance.t check_function diff --git a/kernel/univ.ml b/kernel/univ.ml index 6d8aa02dff..a2fd14025e 100644 --- a/kernel/univ.ml +++ b/kernel/univ.ml @@ -205,12 +205,6 @@ module Level = struct let pr u = str (to_string u) - let apart u v = - match data u, data v with - | SProp, _ | _, SProp - | Prop, Set | Set, Prop -> true - | _ -> false - let vars = Array.init 20 (fun i -> make (Var i)) let var n = @@ -250,7 +244,7 @@ module LMap = struct ext empty let pr f m = - h 0 (prlist_with_sep fnl (fun (u, v) -> + h (prlist_with_sep fnl (fun (u, v) -> Level.pr u ++ f v) (bindings m)) end @@ -568,16 +562,6 @@ let constraint_type_ord c1 c2 = match c1, c2 with | Eq, Eq -> 0 | Eq, _ -> 1 -(* Universe inconsistency: error raised when trying to enforce a relation - that would create a cycle in the graph of universes. *) - -type univ_inconsistency = constraint_type * universe * universe * explanation Lazy.t option - -exception UniverseInconsistency of univ_inconsistency - -let error_inconsistency o u v p = - raise (UniverseInconsistency (o,Universe.make u,Universe.make v,p)) - (* Constraints and sets of constraints. *) type univ_constraint = Level.t * constraint_type * Level.t @@ -660,8 +644,6 @@ type 'a constraint_function = 'a -> 'a -> constraints -> constraints let enforce_eq_level u v c = (* We discard trivial constraints like u=u *) if Level.equal u v then c - else if Level.apart u v then - error_inconsistency Eq u v None else Constraint.add (u,Eq,v) c let enforce_eq u v c = @@ -684,9 +666,9 @@ let constraint_add_leq v u c = let j = m - n in if j = -1 (* n = m+1, v+1 <= u <-> v < u *) then Constraint.add (x,Lt,y) c - else if j <= -1 (* n = m+k, v+k <= u <-> v+(k-1) < u *) then - if Level.equal x y then (* u+(k+1) <= u *) - raise (UniverseInconsistency (Le, Universe.tip v, Universe.tip u, None)) + else if j <= -1 (* n = m+k, v+k <= u and k>0 *) then + if Level.equal x y then (* u+k <= u with k>0 *) + Constraint.add (x,Lt,x) c else anomaly (Pp.str"Unable to handle arbitrary u+k <= v constraints.") else if j = 0 then Constraint.add (x,Le,y) c @@ -703,8 +685,8 @@ let check_univ_leq u v = let enforce_leq u v c = match Universe.is_sprop u, Universe.is_sprop v with | true, true -> c - | true, false | false, true -> - raise (UniverseInconsistency (Le, u, v, None)) + | true, false -> Constraint.add (Level.sprop,Le,Level.prop) c + | false, true -> Constraint.add (Level.prop,Le,Level.sprop) c | false, false -> List.fold_left (fun c v -> (List.fold_left (fun c u -> constraint_add_leq u v c) c u)) c v @@ -961,7 +943,7 @@ struct let pr prl ?variance (univs, cst as ctx) = if is_empty ctx then mt() else - h 0 (Instance.pr prl ?variance univs ++ str " |= ") ++ h 0 (v 0 (Constraint.pr prl cst)) + h (Instance.pr prl ?variance univs ++ str " |= ") ++ h (v 0 (Constraint.pr prl cst)) let hcons (univs, cst) = (Instance.hcons univs, hcons_constraints cst) @@ -1076,7 +1058,7 @@ struct let pr prl (univs, cst as ctx) = if is_empty ctx then mt() else - h 0 (LSet.pr prl univs ++ str " |= ") ++ h 0 (v 0 (Constraint.pr prl cst)) + h (LSet.pr prl univs ++ str " |= ") ++ h (v 0 (Constraint.pr prl cst)) let constraints (_univs, cst) = cst let levels (univs, _cst) = univs @@ -1232,6 +1214,14 @@ let hcons_universe_context_set (v, c) = let hcons_univ x = Universe.hcons x +(* Universe inconsistency: error raised when trying to enforce a relation + that would create a cycle in the graph of universes. *) + +type univ_inconsistency = constraint_type * universe * universe * explanation Lazy.t option + +(* Do not use in this file as we may be type-in-type *) +exception UniverseInconsistency of univ_inconsistency + let explain_universe_inconsistency prl (o,u,v,p : univ_inconsistency) = let pr_uni = Universe.pr_with prl in let pr_rel = function diff --git a/kernel/vconv.ml b/kernel/vconv.ml index cc2c2c0b4b..948195797e 100644 --- a/kernel/vconv.ml +++ b/kernel/vconv.ml @@ -211,5 +211,5 @@ let vm_conv cv_pb env t1 t2 = else Constr.eq_constr_univs univs t1 t2 in if not b then - let univs = (univs, checked_universes) in - let _ = vm_conv_gen cv_pb env univs t1 t2 in () + let state = (univs, checked_universes) in + let _ = vm_conv_gen cv_pb env state t1 t2 in () diff --git a/kernel/vmbytecodes.ml b/kernel/vmbytecodes.ml index 74405a0105..c156a21c86 100644 --- a/kernel/vmbytecodes.ml +++ b/kernel/vmbytecodes.ml @@ -106,14 +106,14 @@ let rec pp_instr i = | Kclosure(lbl, n) -> str "closure " ++ pp_lbl lbl ++ str ", " ++ int n | Kclosurerec(fv,init,lblt,lblb) -> - h 1 (str "closurerec " ++ + hv 1 (str "closurerec " ++ int fv ++ str ", " ++ int init ++ str " types = " ++ prlist_with_sep spc pp_lbl (Array.to_list lblt) ++ str " bodies = " ++ prlist_with_sep spc pp_lbl (Array.to_list lblb)) | Kclosurecofix (fv,init,lblt,lblb) -> - h 1 (str "closurecofix " ++ + hv 1 (str "closurecofix " ++ int fv ++ str ", " ++ int init ++ str " types = " ++ prlist_with_sep spc pp_lbl (Array.to_list lblt) ++ @@ -129,7 +129,7 @@ let rec pp_instr i = str "makeswitchblock " ++ pp_lbl lblt ++ str ", " ++ pp_lbl lbls ++ str ", " ++ int sz | Kswitch(lblc,lblb) -> - h 1 (str "switch " ++ + hv 1 (str "switch " ++ prlist_with_sep spc pp_lbl (Array.to_list lblc) ++ str " | " ++ prlist_with_sep spc pp_lbl (Array.to_list lblb)) diff --git a/kernel/vmbytegen.ml b/kernel/vmbytegen.ml index 375b1aface..16a0f42664 100644 --- a/kernel/vmbytegen.ml +++ b/kernel/vmbytegen.ml @@ -508,7 +508,6 @@ let is_caml_prim = let open CPrimitives in function | Arraydefault | Arrayset | Arraycopy - | Arrayreroot | Arraylength -> true | _ -> false diff --git a/kernel/vmemitcodes.ml b/kernel/vmemitcodes.ml index f913cb906c..ec8601edc9 100644 --- a/kernel/vmemitcodes.ml +++ b/kernel/vmemitcodes.ml @@ -262,7 +262,7 @@ let check_prim_op = function | Arraymake -> opISINT_CAML_CALL2 | Arrayget -> opISARRAY_INT_CAML_CALL2 | Arrayset -> opISARRAY_INT_CAML_CALL3 - | Arraydefault | Arraycopy | Arrayreroot | Arraylength -> + | Arraydefault | Arraycopy | Arraylength -> opISARRAY_CAML_CALL1 let emit_instr env = function diff --git a/kernel/vmsymtable.ml b/kernel/vmsymtable.ml index 4ad830a298..9d80dc578b 100644 --- a/kernel/vmsymtable.ml +++ b/kernel/vmsymtable.ml @@ -69,7 +69,6 @@ let parray_get = set_global Vmvalues.parray_get let parray_get_default = set_global Vmvalues.parray_get_default let parray_set = set_global Vmvalues.parray_set let parray_copy = set_global Vmvalues.parray_copy -let parray_reroot = set_global Vmvalues.parray_reroot let parray_length = set_global Vmvalues.parray_length (* table pour les structured_constant et les annotations des switchs *) @@ -135,7 +134,6 @@ let slot_for_caml_prim = | Arraydefault -> parray_get_default | Arrayset -> parray_set | Arraycopy -> parray_copy - | Arrayreroot -> parray_reroot | Arraylength -> parray_length | _ -> assert false diff --git a/kernel/vmvalues.ml b/kernel/vmvalues.ml index 0678f37a0b..2068133b10 100644 --- a/kernel/vmvalues.ml +++ b/kernel/vmvalues.ml @@ -700,5 +700,4 @@ let parray_get = Obj.magic Parray.get let parray_get_default = Obj.magic Parray.default let parray_set = Obj.magic Parray.set let parray_copy = Obj.magic Parray.copy -let parray_reroot = Obj.magic Parray.reroot let parray_length = Obj.magic Parray.length diff --git a/kernel/vmvalues.mli b/kernel/vmvalues.mli index 6632dc46b2..d15595766a 100644 --- a/kernel/vmvalues.mli +++ b/kernel/vmvalues.mli @@ -204,5 +204,4 @@ val parray_get : values val parray_get_default : values val parray_set : values val parray_copy : values -val parray_reroot : values val parray_length : values diff --git a/lib/explore.ml b/lib/explore.ml index b3ffef6ac2..139de488e2 100644 --- a/lib/explore.ml +++ b/lib/explore.ml @@ -29,7 +29,7 @@ module Make = functor(S : SearchProblem) -> struct | [i] -> int i | i :: l -> pp_rec l ++ str "." ++ int i in - Feedback.msg_debug (h 0 (pp_rec p) ++ pp) + Feedback.msg_debug (h (pp_rec p) ++ pp) (*s Depth first search. *) diff --git a/lib/flags.ml b/lib/flags.ml index 1d9d6d49bc..83733cf00d 100644 --- a/lib/flags.ml +++ b/lib/flags.ml @@ -47,6 +47,7 @@ let async_proofs_is_worker () = !async_proofs_worker_id <> "master" let load_vos_libraries = ref false let debug = ref false +let xml_debug = ref false let in_debugger = ref false let in_toplevel = ref false diff --git a/lib/flags.mli b/lib/flags.mli index 30d1b5b2bd..ebd23a4d20 100644 --- a/lib/flags.mli +++ b/lib/flags.mli @@ -41,6 +41,7 @@ val load_vos_libraries : bool ref (** Debug flags *) val debug : bool ref +val xml_debug : bool ref val in_debugger : bool ref val in_toplevel : bool ref @@ -22,7 +22,7 @@ type pp_tag = string type block_type = - | Pp_hbox of int + | Pp_hbox | Pp_vbox of int | Pp_hvbox of int | Pp_hovbox of int @@ -131,7 +131,7 @@ let strbrk s = let ismt = function | Ppcmd_empty -> true | _ -> false (* boxing commands *) -let h n s = Ppcmd_box(Pp_hbox n,s) +let h s = Ppcmd_box(Pp_hbox,s) let v n s = Ppcmd_box(Pp_vbox n,s) let hv n s = Ppcmd_box(Pp_hvbox n,s) let hov n s = Ppcmd_box(Pp_hovbox n,s) @@ -151,7 +151,7 @@ let escape_string s = let qstring s = str "\"" ++ str (escape_string s) ++ str "\"" let qs = qstring -let quote s = h 0 (str "\"" ++ s ++ str "\"") +let quote s = h (str "\"" ++ s ++ str "\"") let rec pr_com ft s = let (s1,os) = @@ -181,7 +181,7 @@ let split_tag tag = (* pretty printing functions *) let pp_with ft pp = let cpp_open_box = function - | Pp_hbox n -> Format.pp_open_hbox ft () + | Pp_hbox -> Format.pp_open_hbox ft () | Pp_vbox n -> Format.pp_open_vbox ft n | Pp_hvbox n -> Format.pp_open_hvbox ft n | Pp_hovbox n -> Format.pp_open_hovbox ft n @@ -309,12 +309,14 @@ let db_print_pp fmt pp = let block_type fmt btype = let (bt, v) = match btype with - | Pp_hbox v -> ("Pp_hbox", v) - | Pp_vbox v -> ("Pp_vbox", v) - | Pp_hvbox v -> ("Pp_hvbox", v) - | Pp_hovbox v -> ("Pp_hovbox", v) + | Pp_hbox -> ("Pp_hbox", None) + | Pp_vbox v -> ("Pp_vbox", Some v) + | Pp_hvbox v -> ("Pp_hvbox", Some v) + | Pp_hovbox v -> ("Pp_hovbox", Some v) in - fprintf fmt "%s %d" bt v + match v with + | None -> fprintf fmt "%s" bt + | Some v -> fprintf fmt "%s %d" bt v in let rec db_print_pp_r indent pp = let ind () = fprintf fmt "%s" (String.make (2 * indent) ' ') in diff --git a/lib/pp.mli b/lib/pp.mli index b265537728..12f1ba9bb2 100644 --- a/lib/pp.mli +++ b/lib/pp.mli @@ -43,7 +43,7 @@ type pp_tag = string type t type block_type = - | Pp_hbox of int + | Pp_hbox | Pp_vbox of int | Pp_hvbox of int | Pp_hovbox of int @@ -99,7 +99,7 @@ val strbrk : string -> t (** {6 Boxing commands} *) -val h : int -> t -> t +val h : t -> t val v : int -> t -> t val hv : int -> t -> t val hov : int -> t -> t diff --git a/lib/pp_diff.ml b/lib/pp_diff.ml index 988e8e4303..4593bf4b07 100644 --- a/lib/pp_diff.ml +++ b/lib/pp_diff.ml @@ -109,7 +109,7 @@ let shorten_diff_span dtype diff_list = iter 0 len (<) 1; (* left to right *) iter (len-1) (-1) (>) (-1); (* right to left *) - if !changed then Array.to_list diffs else diff_list;; + if !changed then Array.to_list diffs else diff_list let has_changes diffs = let rec has_changes_r diffs added removed = @@ -118,12 +118,12 @@ let has_changes diffs = | `Removed _ :: t -> has_changes_r t added true | h :: t -> has_changes_r t added removed | [] -> (added, removed) in - has_changes_r diffs false false;; + has_changes_r diffs false false (* get the Myers diff of 2 lists of strings *) let diff_strs old_strs new_strs = let diffs = List.rev (StringDiff.diff old_strs new_strs) in - shorten_diff_span `Removed (shorten_diff_span `Added diffs);; + shorten_diff_span `Removed (shorten_diff_span `Added diffs) (* Default string tokenizer. Makes each character a separate strin. Whitespace is not ignored. Doesn't handle UTF-8 differences well. *) @@ -139,7 +139,7 @@ let def_tokenize_string s = let diff_str ?(tokenize_string=def_tokenize_string) old_str new_str = let old_toks = Array.of_list (tokenize_string old_str) and new_toks = Array.of_list (tokenize_string new_str) in - diff_strs old_toks new_toks;; + diff_strs old_toks new_toks let get_dinfo = function | `Common (_, _, s) -> (`Common, s) @@ -281,14 +281,14 @@ let add_diff_tags which pp diffs = skip (); if !diffs <> [] then raise (Diff_Failure "left-over diff info at end of Pp.t, should be impossible"); - if has_added || has_removed then wrap_in_bg diff_tag rv else rv;; + if has_added || has_removed then wrap_in_bg diff_tag rv else rv let diff_pp ?(tokenize_string=def_tokenize_string) o_pp n_pp = let open Pp in let o_str = string_of_ppcmds o_pp in let n_str = string_of_ppcmds n_pp in let diffs = diff_str ~tokenize_string o_str n_str in - (add_diff_tags `Removed o_pp diffs, add_diff_tags `Added n_pp diffs);; + (add_diff_tags `Removed o_pp diffs, add_diff_tags `Added n_pp diffs) let diff_pp_combined ?(tokenize_string=def_tokenize_string) ?(show_removed=false) o_pp n_pp = let open Pp in @@ -300,4 +300,4 @@ let diff_pp_combined ?(tokenize_string=def_tokenize_string) ?(show_removed=false if show_removed && has_removed then let removed = add_diff_tags `Removed o_pp diffs in (v 0 (removed ++ cut() ++ added)) - else added;; + else added diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg index 1ec83c496a..644493a010 100644 --- a/parsing/g_constr.mlg +++ b/parsing/g_constr.mlg @@ -154,7 +154,7 @@ GRAMMAR EXTEND Gram | "10" LEFTA [ f = operconstr; args = LIST1 appl_arg -> { CAst.make ~loc @@ CApp((None,f),args) } | "@"; f = global; i = univ_instance; args = LIST0 NEXT -> { CAst.make ~loc @@ CAppExpl((None,f,i),args) } - | "@"; lid = pattern_identref; args = LIST1 identref -> + | "@"; lid = pattern_ident; args = LIST1 identref -> { let { CAst.loc = locid; v = id } = lid in let args = List.map (fun x -> CAst.make @@ CRef (qualid_of_ident ?loc:x.CAst.loc x.CAst.v, None), None) args in CAst.make ~loc @@ CApp((None, CAst.make ?loc:locid @@ CPatVar id),args) } ] @@ -252,7 +252,7 @@ GRAMMAR EXTEND Gram | "cofix"; c = cofix_decls -> { let (id,dcls) = c in CAst.make ~loc @@ CCoFix (id,dcls) } ] ] ; appl_arg: - [ [ test_lpar_id_coloneq; "("; id = ident; ":="; c = lconstr; ")" -> { (c,Some (CAst.make ~loc @@ ExplByName id)) } + [ [ test_lpar_id_coloneq; "("; id = identref; ":="; c = lconstr; ")" -> { (c,Some (CAst.make ?loc:id.CAst.loc @@ ExplByName id.CAst.v)) } | c=operconstr LEVEL "9" -> { (c,None) } ] ] ; atomic_constr: @@ -261,12 +261,12 @@ GRAMMAR EXTEND Gram | n = NUMBER-> { CAst.make ~loc @@ CPrim (Numeral (NumTok.SPlus,n)) } | s = string -> { CAst.make ~loc @@ CPrim (String s) } | "_" -> { CAst.make ~loc @@ CHole (None, IntroAnonymous, None) } - | "?"; "["; id = ident; "]" -> { CAst.make ~loc @@ CHole (None, IntroIdentifier id, None) } - | "?"; "["; id = pattern_ident; "]" -> { CAst.make ~loc @@ CHole (None, IntroFresh id, None) } + | "?"; "["; id = identref; "]" -> { CAst.make ~loc @@ CHole (None, IntroIdentifier id.CAst.v, None) } + | "?"; "["; id = pattern_ident; "]" -> { CAst.make ~loc @@ CHole (None, IntroFresh id.CAst.v, None) } | id = pattern_ident; inst = evar_instance -> { CAst.make ~loc @@ CEvar(id,inst) } ] ] ; inst: - [ [ id = ident; ":="; c = lconstr -> { (id,c) } ] ] + [ [ id = identref; ":="; c = lconstr -> { (id,c) } ] ] ; evar_instance: [ [ "@{"; l = LIST1 inst SEP ";"; "}" -> { l } diff --git a/parsing/g_prim.mlg b/parsing/g_prim.mlg index 270662b824..1701830cd2 100644 --- a/parsing/g_prim.mlg +++ b/parsing/g_prim.mlg @@ -45,9 +45,9 @@ let test_minus_nat = GRAMMAR EXTEND Gram GLOBAL: - bignat bigint natural integer identref name ident var preident + bignat bigint natural integer identref name ident hyp preident fullyqualid qualid reference dirpath ne_lstring - ne_string string lstring pattern_ident pattern_identref by_notation + ne_string string lstring pattern_ident by_notation smart_global bar_cbrace strategy_level; preident: [ [ s = IDENT -> { s } ] ] @@ -56,17 +56,14 @@ GRAMMAR EXTEND Gram [ [ s = IDENT -> { Id.of_string s } ] ] ; pattern_ident: - [ [ LEFTQMARK; id = ident -> { id } ] ] - ; - pattern_identref: - [ [ id = pattern_ident -> { CAst.make ~loc id } ] ] - ; - var: (* as identref, but interpret as a term identifier in ltac *) - [ [ id = ident -> { CAst.make ~loc id } ] ] + [ [ LEFTQMARK; id = ident -> { CAst.make ~loc id } ] ] ; identref: [ [ id = ident -> { CAst.make ~loc id } ] ] ; + hyp: (* as identref, but interpreted as an hypothesis in tactic notations *) + [ [ id = identref -> { id } ] ] + ; field: [ [ s = FIELD -> { Id.of_string s } ] ] ; diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml index 723f08413e..996aa0925c 100644 --- a/parsing/pcoq.ml +++ b/parsing/pcoq.ml @@ -279,14 +279,15 @@ module Prim = let strategy_level = Entry.create "strategy_level" (* parsed like ident but interpreted as a term *) - let var = Entry.create "var" + let hyp = Entry.create "hyp" + let var = hyp let name = Entry.create "name" let identref = Entry.create "identref" let univ_decl = Entry.create "univ_decl" let ident_decl = Entry.create "ident_decl" let pattern_ident = Entry.create "pattern_ident" - let pattern_identref = Entry.create "pattern_identref" + let pattern_identref = pattern_ident (* To remove in 8.14 *) (* A synonym of ident - maybe ident will be located one day *) let base_ident = Entry.create "base_ident" @@ -504,7 +505,7 @@ let () = Grammar.register0 wit_string (Prim.string); Grammar.register0 wit_pre_ident (Prim.preident); Grammar.register0 wit_ident (Prim.ident); - Grammar.register0 wit_var (Prim.var); + Grammar.register0 wit_hyp (Prim.hyp); Grammar.register0 wit_ref (Prim.reference); Grammar.register0 wit_smart_global (Prim.smart_global); Grammar.register0 wit_sort_family (Constr.sort_family); diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index ae9a7423c2..8e60bbf504 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -156,8 +156,8 @@ module Prim : val identref : lident Entry.t val univ_decl : universe_decl_expr Entry.t val ident_decl : ident_decl Entry.t - val pattern_ident : Id.t Entry.t - val pattern_identref : lident Entry.t + val pattern_ident : lident Entry.t + val pattern_identref : lident Entry.t [@@ocaml.deprecated "Use Prim.pattern_identref"] val base_ident : Id.t Entry.t val bignat : string Entry.t val natural : int Entry.t @@ -173,7 +173,8 @@ module Prim : val dirpath : DirPath.t Entry.t val ne_string : string Entry.t val ne_lstring : lstring Entry.t - val var : lident Entry.t + val hyp : lident Entry.t + val var : lident Entry.t [@@ocaml.deprecated "Use Prim.hyp"] val bar_cbrace : unit Entry.t val strategy_level : Conv_oracle.level Entry.t end diff --git a/parsing/ppextend.ml b/parsing/ppextend.ml index fe6e8360c1..aab385a707 100644 --- a/parsing/ppextend.ml +++ b/parsing/ppextend.ml @@ -17,7 +17,7 @@ open Constrexpr (*s Pretty-print. *) type ppbox = - | PpHB of int + | PpHB | PpHOVB of int | PpHVB of int | PpVB of int @@ -27,7 +27,7 @@ type ppcut = | PpFnl let ppcmd_of_box = function - | PpHB n -> h n + | PpHB -> h | PpHOVB n -> hov n | PpHVB n -> hv n | PpVB n -> v n diff --git a/parsing/ppextend.mli b/parsing/ppextend.mli index ee8180c7aa..56a3fc8e3c 100644 --- a/parsing/ppextend.mli +++ b/parsing/ppextend.mli @@ -13,7 +13,7 @@ open Constrexpr (** {6 Pretty-print. } *) type ppbox = - | PpHB of int + | PpHB | PpHOVB of int | PpHVB of int | PpVB of int diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml index ee50476b10..f671860bd5 100644 --- a/plugins/extraction/scheme.ml +++ b/plugins/extraction/scheme.ml @@ -28,7 +28,7 @@ let keywords = "error"; "delay"; "force"; "_"; "__"] Id.Set.empty -let pp_comment s = str";; "++h 0 s++fnl () +let pp_comment s = str ";; " ++ h s ++ fnl () let pp_header_comment = function | None -> mt () diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml index 1ea803f561..012fcee486 100644 --- a/plugins/funind/gen_principle.ml +++ b/plugins/funind/gen_principle.ml @@ -1860,13 +1860,13 @@ let do_generate_principle_aux pconstants on_error register_built let warn_cannot_define_graph = CWarnings.create ~name:"funind-cannot-define-graph" ~category:"funind" (fun (names, error) -> - Pp.(strbrk "Cannot define graph(s) for " ++ h 1 names ++ error)) + Pp.(strbrk "Cannot define graph(s) for " ++ hv 1 names ++ error)) let warn_cannot_define_principle = CWarnings.create ~name:"funind-cannot-define-principle" ~category:"funind" (fun (names, error) -> Pp.( - strbrk "Cannot define induction principle(s) for " ++ h 1 names ++ error)) + strbrk "Cannot define induction principle(s) for " ++ hv 1 names ++ error)) let warning_error names e = let e_explain e = @@ -1898,7 +1898,7 @@ let error_error names e = CErrors.user_err Pp.( str "Cannot define graph(s) for " - ++ h 1 + ++ hv 1 (prlist_with_sep (fun _ -> str "," ++ spc ()) Ppconstr.pr_id names) ++ e_explain e) | _ -> raise e diff --git a/plugins/ltac/coretactics.mlg b/plugins/ltac/coretactics.mlg index f1f538ab39..b7ac71181a 100644 --- a/plugins/ltac/coretactics.mlg +++ b/plugins/ltac/coretactics.mlg @@ -20,8 +20,6 @@ open Tacarg open Names open Logic -let wit_hyp = wit_var - } DECLARE PLUGIN "ltac_plugin" diff --git a/plugins/ltac/extraargs.mlg b/plugins/ltac/extraargs.mlg index 863c4d37d8..ad4374dba3 100644 --- a/plugins/ltac/extraargs.mlg +++ b/plugins/ltac/extraargs.mlg @@ -47,7 +47,7 @@ let () = let () = let register name entry = Tacentries.register_tactic_notation_entry name entry in - register "hyp" wit_var; + register "hyp" wit_hyp; register "simple_intropattern" wit_simple_intropattern; register "integer" wit_integer; register "reference" wit_ref; @@ -140,7 +140,7 @@ ARGUMENT EXTEND occurrences GLOB_PRINTED BY { pr_occurrences } | [ ne_integer_list(l) ] -> { ArgArg l } -| [ var(id) ] -> { ArgVar id } +| [ hyp(id) ] -> { ArgVar id } END { diff --git a/plugins/ltac/extratactics.mlg b/plugins/ltac/extratactics.mlg index 4f20e5a800..a2a47c0bf4 100644 --- a/plugins/ltac/extratactics.mlg +++ b/plugins/ltac/extratactics.mlg @@ -33,8 +33,6 @@ open Proofview.Notations open Attributes open Vernacextend -let wit_hyp = wit_var - } DECLARE PLUGIN "ltac_plugin" @@ -450,7 +448,7 @@ END (* Subst *) TACTIC EXTEND subst -| [ "subst" ne_var_list(l) ] -> { subst l } +| [ "subst" ne_hyp_list(l) ] -> { subst l } | [ "subst" ] -> { subst_all () } END diff --git a/plugins/ltac/g_auto.mlg b/plugins/ltac/g_auto.mlg index 2e72ceae5a..44472a1995 100644 --- a/plugins/ltac/g_auto.mlg +++ b/plugins/ltac/g_auto.mlg @@ -18,8 +18,6 @@ open Pcoq.Constr open Pltac open Hints -let wit_hyp = wit_var - } DECLARE PLUGIN "ltac_plugin" diff --git a/plugins/ltac/g_class.mlg b/plugins/ltac/g_class.mlg index 8d197e6056..8c2e633be5 100644 --- a/plugins/ltac/g_class.mlg +++ b/plugins/ltac/g_class.mlg @@ -31,12 +31,12 @@ let set_transparency cl b = } VERNAC COMMAND EXTEND Typeclasses_Unfold_Settings CLASSIFIED AS SIDEFF -| [ "Typeclasses" "Transparent" reference_list(cl) ] -> { +| [ "Typeclasses" "Transparent" ne_reference_list(cl) ] -> { set_transparency cl true } END VERNAC COMMAND EXTEND Typeclasses_Rigid_Settings CLASSIFIED AS SIDEFF -| [ "Typeclasses" "Opaque" reference_list(cl) ] -> { +| [ "Typeclasses" "Opaque" ne_reference_list(cl) ] -> { set_transparency cl false } END @@ -77,7 +77,7 @@ END (* true = All transparent, false = Opaque if possible *) VERNAC COMMAND EXTEND Typeclasses_Settings CLASSIFIED AS SIDEFF - | [ "Typeclasses" "eauto" ":=" debug(d) eauto_search_strategy(s) integer_opt(depth) ] -> { + | [ "Typeclasses" "eauto" ":=" debug(d) eauto_search_strategy(s) natural_opt(depth) ] -> { set_typeclasses_debug d; Option.iter set_typeclasses_strategy s; set_typeclasses_depth depth @@ -87,11 +87,13 @@ END (** Compatibility: typeclasses eauto has 8.5 and 8.6 modes *) TACTIC EXTEND typeclasses_eauto | [ "typeclasses" "eauto" "bfs" int_or_var_opt(d) "with" ne_preident_list(l) ] -> - { typeclasses_eauto ~strategy:Bfs ~depth:d l } + { typeclasses_eauto ~depth:d ~strategy:Bfs l } | [ "typeclasses" "eauto" int_or_var_opt(d) "with" ne_preident_list(l) ] -> { typeclasses_eauto ~depth:d l } + | [ "typeclasses" "eauto" "bfs" int_or_var_opt(d) ] -> { + typeclasses_eauto ~depth:d ~strategy:Bfs ~only_classes:true [Class_tactics.typeclasses_db] } | [ "typeclasses" "eauto" int_or_var_opt(d) ] -> { - typeclasses_eauto ~only_classes:true ~depth:d [Class_tactics.typeclasses_db] } + typeclasses_eauto ~depth:d ~only_classes:true [Class_tactics.typeclasses_db] } END TACTIC EXTEND head_of_constr diff --git a/plugins/ltac/g_ltac.mlg b/plugins/ltac/g_ltac.mlg index be0d71ad46..6cf5d30a95 100644 --- a/plugins/ltac/g_ltac.mlg +++ b/plugins/ltac/g_ltac.mlg @@ -355,28 +355,8 @@ GRAMMAR EXTEND Gram open Stdarg open Tacarg open Vernacextend -open Goptions open Libnames -let print_info_trace = - declare_intopt_option_and_ref ~depr:false ~key:["Info" ; "Level"] - -let vernac_solve ~pstate n info tcom b = - let open Goal_select in - let pstate, status = Declare.Proof.map_fold_endline ~f:(fun etac p -> - let with_end_tac = if b then Some etac else None in - let global = match n with SelectAll | SelectList _ -> true | _ -> false in - let info = Option.append info (print_info_trace ()) in - let (p,status) = - Proof.solve n info (Tacinterp.hide_interp global tcom None) ?with_end_tac p - in - (* in case a strict subtree was completed, - go back to the top of the prooftree *) - let p = Proof.maximal_unfocus Vernacentries.command_focus p in - p,status) pstate in - if not status then Feedback.feedback Feedback.AddedAxiom; - pstate - let pr_ltac_selector s = Pptactic.pr_goal_selector ~toplevel:true s } @@ -409,34 +389,34 @@ END { -let is_anonymous_abstract = function - | TacAbstract (_,None) -> true - | TacSolve [TacAbstract (_,None)] -> true - | _ -> false let rm_abstract = function - | TacAbstract (t,_) -> t - | TacSolve [TacAbstract (t,_)] -> TacSolve [t] - | x -> x + | TacAbstract (t,_) -> t, true + | TacSolve [TacAbstract (t,_)] -> TacSolve [t], true + | x -> x, false let is_explicit_terminator = function TacSolve _ -> true | _ -> false } VERNAC { tactic_mode } EXTEND VernacSolve STATE proof -| [ ltac_selector_opt(g) ltac_info_opt(n) tactic(t) ltac_use_default(def) ] => +| [ ltac_selector_opt(g) ltac_info_opt(info) tactic(t) ltac_use_default(with_end_tac) ] => { classify_as_proofstep } -> { let g = Option.default (Goal_select.get_default_goal_selector ()) g in - vernac_solve g n t def + let global = match g with Goal_select.SelectAll | Goal_select.SelectList _ -> true | _ -> false in + let t = ComTactic.I (Tacinterp.hide_interp, { Tacinterp.global; ast = t; }) in + ComTactic.solve g ~info t ~with_end_tac } -| [ "par" ":" ltac_info_opt(n) tactic(t) ltac_use_default(def) ] => +END + +VERNAC { tactic_mode } EXTEND VernacSolveParallel STATE proof +| [ "par" ":" ltac_info_opt(info) tactic(t) ltac_use_default(with_end_tac) ] => { - let anon_abstracting_tac = is_anonymous_abstract t in let solving_tac = is_explicit_terminator t in - let parallel = `Yes (solving_tac,anon_abstracting_tac) in let pbr = if solving_tac then Some "par" else None in - VtProofStep{ parallel = parallel; proof_block_detection = pbr } + VtProofStep{ proof_block_detection = pbr } } -> { - let t = rm_abstract t in - vernac_solve Goal_select.SelectAll n t def + let t, abstract = rm_abstract t in + let t = ComTactic.I (Tacinterp.hide_interp, { Tacinterp.global = true; ast = t; }) in + ComTactic.solve_parallel ~info t ~abstract ~with_end_tac } END diff --git a/plugins/ltac/g_obligations.mlg b/plugins/ltac/g_obligations.mlg index fc24475a62..6bf330c830 100644 --- a/plugins/ltac/g_obligations.mlg +++ b/plugins/ltac/g_obligations.mlg @@ -111,6 +111,8 @@ END VERNAC COMMAND EXTEND Solve_Obligations CLASSIFIED AS SIDEFF STATE program | [ "Solve" "Obligations" "of" ident(name) "with" tactic(t) ] -> { try_solve_obligations (Some name) (Some (Tacinterp.interp t)) } +| [ "Solve" "Obligations" "of" ident(name) ] -> + { try_solve_obligations (Some name) None } | [ "Solve" "Obligations" "with" tactic(t) ] -> { try_solve_obligations None (Some (Tacinterp.interp t)) } | [ "Solve" "Obligations" ] -> diff --git a/plugins/ltac/g_rewrite.mlg b/plugins/ltac/g_rewrite.mlg index 8331927cda..ee94fd565a 100644 --- a/plugins/ltac/g_rewrite.mlg +++ b/plugins/ltac/g_rewrite.mlg @@ -29,8 +29,6 @@ open Pvernac.Vernac_ open Pltac open Vernacextend -let wit_hyp = wit_var - } DECLARE PLUGIN "ltac_plugin" diff --git a/plugins/ltac/g_tactic.mlg b/plugins/ltac/g_tactic.mlg index e51b1f051d..c186a83a5c 100644 --- a/plugins/ltac/g_tactic.mlg +++ b/plugins/ltac/g_tactic.mlg @@ -280,7 +280,7 @@ GRAMMAR EXTEND Gram | "[="; tc = intropatterns; "]" -> { IntroInjection tc } ] ] ; naming_intropattern: - [ [ prefix = pattern_ident -> { IntroFresh prefix } + [ [ prefix = pattern_ident -> { IntroFresh prefix.CAst.v } | "?" -> { IntroAnonymous } | id = ident -> { IntroIdentifier id } ] ] ; diff --git a/plugins/ltac/leminv.ml b/plugins/ltac/leminv.ml index 47df3ec34f..f42c1f73a3 100644 --- a/plugins/ltac/leminv.ml +++ b/plugins/ltac/leminv.ml @@ -245,7 +245,8 @@ let add_inversion_lemma ~poly name env sigma t sort dep inv_op = let add_inversion_lemma_exn ~poly na com comsort bool tac = let env = Global.env () in let sigma = Evd.from_env env in - let sigma, c = Constrintern.interp_type_evars ~program_mode:false env sigma com in + let c, uctx = Constrintern.interp_type env sigma com in + let sigma = Evd.from_ctx uctx in let sigma, sort = Evd.fresh_sort_in_family ~rigid:univ_rigid sigma comsort in add_inversion_lemma ~poly na env sigma c sort bool tac diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml index 85bb901046..fe896f9351 100644 --- a/plugins/ltac/pptactic.ml +++ b/plugins/ltac/pptactic.ml @@ -179,7 +179,7 @@ let string_of_genarg_arg (ArgumentType arg) = | ConstrTypeOf c -> hov 1 (keyword "type of" ++ spc() ++ prc env sigma c) | ConstrTerm c when test c -> - h 0 (str "(" ++ prc env sigma c ++ str ")") + h (str "(" ++ prc env sigma c ++ str ")") | ConstrTerm c -> prc env sigma c @@ -1323,7 +1323,7 @@ let () = register_basic_print0 wit_smart_global (pr_or_by_notation pr_qualid) (pr_or_var (pr_located pr_global)) pr_global; register_basic_print0 wit_ident pr_id pr_id pr_id; - register_basic_print0 wit_var pr_lident pr_lident pr_id; + register_basic_print0 wit_hyp pr_lident pr_lident pr_id; register_print0 wit_intropattern pr_raw_intro_pattern pr_glob_intro_pattern pr_intro_pattern_env [@warning "-3"]; register_print0 wit_simple_intropattern pr_raw_intro_pattern pr_glob_intro_pattern pr_intro_pattern_env; Genprint.register_print0 diff --git a/plugins/ltac/profile_ltac.ml b/plugins/ltac/profile_ltac.ml index 0dbf16a821..9c15d24dd3 100644 --- a/plugins/ltac/profile_ltac.ml +++ b/plugins/ltac/profile_ltac.ml @@ -146,7 +146,7 @@ let header = fnl () let rec print_node ~filter all_total indent prefix (s, e) = - h 0 ( + h ( padr_with '-' 40 (prefix ^ s ^ " ") ++ padl 7 (format_ratio (e.local /. all_total)) ++ padl 7 (format_ratio (e.total /. all_total)) @@ -212,7 +212,7 @@ let to_string ~filter ?(cutoff=0.0) node = in let filter s n = filter s && (all_total <= 0.0 || n /. all_total >= cutoff /. 100.0) in let msg = - h 0 (str "total time: " ++ padl 11 (format_sec (all_total))) ++ + h (str "total time: " ++ padl 11 (format_sec (all_total))) ++ fnl () ++ fnl () ++ header ++ diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml index 8de6cbc0a6..9bb435f4dc 100644 --- a/plugins/ltac/rewrite.ml +++ b/plugins/ltac/rewrite.ml @@ -498,7 +498,7 @@ let rec decompose_app_rel env evd t = let decompose_app_rel env evd t = let (rel, t1, t2) = decompose_app_rel env evd t in - let ty = Retyping.get_type_of env evd rel in + let ty = try Retyping.get_type_of ~lax:true env evd rel with Retyping.RetypeError _ -> error_no_relation () in let () = if not (Reductionops.is_arity env evd ty) then error_no_relation () in (rel, t1, t2) @@ -769,7 +769,7 @@ let get_rew_prf evars r = match r.rew_prf with let poly_subrelation sort = if sort then PropGlobal.subrelation else TypeGlobal.subrelation -let resolve_subrelation env avoid car rel sort prf rel' res = +let resolve_subrelation env car rel sort prf rel' res = if Termops.eq_constr (fst res.rew_evars) rel rel' then res else let evars, app = app_poly_check env res.rew_evars (poly_subrelation sort) [|car; rel; rel'|] in @@ -779,7 +779,7 @@ let resolve_subrelation env avoid car rel sort prf rel' res = rew_prf = RewPrf (rel', appsub); rew_evars = evars } -let resolve_morphism env avoid oldt m ?(fnewt=fun x -> x) args args' (b,cstr) evars = +let resolve_morphism env m args args' (b,cstr) evars = let evars, morph_instance, proj, sigargs, m', args, args' = let first = match (Array.findi (fun _ b -> not (Option.is_empty b)) args') with | Some i -> i @@ -843,18 +843,18 @@ let resolve_morphism env avoid oldt m ?(fnewt=fun x -> x) args args' (b,cstr) ev let proof = applist (proj, List.rev projargs) in let newt = applist (m', List.rev typeargs) in match respars with - [ a, Some r ] -> evars, proof, substl subst a, substl subst r, oldt, fnewt newt + [ a, Some r ] -> evars, proof, substl subst a, substl subst r, newt | _ -> assert(false) -let apply_constraint env avoid car rel prf cstr res = +let apply_constraint env car rel prf cstr res = match snd cstr with | None -> res - | Some r -> resolve_subrelation env avoid car rel (fst cstr) prf r res + | Some r -> resolve_subrelation env car rel (fst cstr) prf r res -let coerce env avoid cstr res = +let coerce env cstr res = let evars, (rel, prf) = get_rew_prf res.rew_evars res in let res = { res with rew_evars = evars } in - apply_constraint env avoid res.rew_car rel prf cstr res + apply_constraint env res.rew_car rel prf cstr res let apply_rule unify loccs : int pure_strategy = let (nowhere_except_in,occs) = convert_occs loccs in @@ -863,7 +863,7 @@ let apply_rule unify loccs : int pure_strategy = then List.mem occ occs else not (List.mem occ occs) in - { strategy = fun { state = occ ; env ; unfresh ; + { strategy = fun { state = occ ; env ; term1 = t ; ty1 = ty ; cstr ; evars } -> let unif = if isEvar (goalevars evars) t then None else unify env evars t in match unif with @@ -874,7 +874,7 @@ let apply_rule unify loccs : int pure_strategy = else if Termops.eq_constr (fst rew.rew_evars) t rew.rew_to then (occ, Identity) else let res = { rew with rew_car = ty } in - let res = Success (coerce env unfresh cstr res) in + let res = Success (coerce env cstr res) in (occ, res) } @@ -1017,10 +1017,10 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy = | None -> false | Some r -> not (is_rew_cast r.rew_prf)) args' then - let evars', prf, car, rel, c1, c2 = - resolve_morphism env unfresh t m args args' (prop, cstr') evars' + let evars', prf, car, rel, c2 = + resolve_morphism env m args args' (prop, cstr') evars' in - let res = { rew_car = ty; rew_from = c1; + let res = { rew_car = ty; rew_from = t; rew_to = c2; rew_prf = RewPrf (rel, prf); rew_evars = evars' } in Success res @@ -1071,7 +1071,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy = let res = match prf with | RewPrf (rel, prf) -> - Success (apply_constraint env unfresh res.rew_car + Success (apply_constraint env res.rew_car rel prf (prop,cstr) res) | _ -> Success res in state, res @@ -1094,20 +1094,6 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy = | Fail | Identity -> res in state, res - (* if x' = None && flags.under_lambdas then *) - (* let lam = mkLambda (n, x, b) in *) - (* let lam', occ = aux env lam occ None in *) - (* let res = *) - (* match lam' with *) - (* | None -> None *) - (* | Some (prf, (car, rel, c1, c2)) -> *) - (* Some (resolve_morphism env sigma t *) - (* ~fnewt:unfold_all *) - (* (Lazy.force coq_all) [| x ; lam |] [| None; lam' |] *) - (* cstr evars) *) - (* in res, occ *) - (* else *) - | Prod (n, dom, codom) -> let lam = mkLambda (n, dom, codom) in let (evars', app), unfold = @@ -1131,31 +1117,13 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy = B. Barras' idea is to have a context of relations, of length 1, with Σ for gluing dependent relations and using projections to get them out. *) - (* | Lambda (n, t, b) when flags.under_lambdas -> *) - (* let n' = name_app (fun id -> Tactics.fresh_id_in_env avoid id env) n in *) - (* let n'' = name_app (fun id -> Tactics.fresh_id_in_env avoid id env) n' in *) - (* let n''' = name_app (fun id -> Tactics.fresh_id_in_env avoid id env) n'' in *) - (* let rel = new_cstr_evar cstr env (mkApp (Lazy.force coq_relation, [|t|])) in *) - (* let env' = Environ.push_rel_context [(n'',None,lift 2 rel);(n'',None,lift 1 t);(n', None, t)] env in *) - (* let b' = s env' avoid b (Typing.type_of env' (goalevars evars) (lift 2 b)) (unlift_cstr env (goalevars evars) cstr) evars in *) - (* (match b' with *) - (* | Some (Some r) -> *) - (* let prf = match r.rew_prf with *) - (* | RewPrf (rel, prf) -> *) - (* let rel = pointwise_or_dep_relation n' t r.rew_car rel in *) - (* let prf = mkLambda (n', t, prf) in *) - (* RewPrf (rel, prf) *) - (* | x -> x *) - (* in *) - (* Some (Some { r with *) - (* rew_prf = prf; *) - (* rew_car = mkProd (n, t, r.rew_car); *) - (* rew_from = mkLambda(n, t, r.rew_from); *) - (* rew_to = mkLambda (n, t, r.rew_to) }) *) - (* | _ -> b') *) | Lambda (n, t, b) when flags.under_lambdas -> let n' = map_annot (Nameops.Name.map (fun id -> Tactics.fresh_id_in_env unfresh id env)) n in + let unfresh = match n'.binder_name with + | Anonymous -> unfresh + | Name id -> Id.Set.add id unfresh + in let open Context.Rel.Declaration in let env' = EConstr.push_rel (LocalAssum (n', t)) env in let bty = Retyping.get_type_of env' (goalevars evars) b in @@ -1196,7 +1164,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy = | Success r -> let case = mkCase (ci, lift 1 p, map_invert (lift 1) iv, mkRel 1, Array.map (lift 1) brs) in let res = make_leibniz_proof env case ty r in - state, Success (coerce env unfresh (prop,cstr) res) + state, Success (coerce env (prop,cstr) res) | Fail | Identity -> if Array.for_all (Int.equal 0) ci.ci_cstr_ndecls then let evars', eqty = app_poly_sort prop env evars coq_eq [| ty |] in @@ -1237,7 +1205,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy = in let res = match res with - | Success r -> Success (coerce env unfresh (prop,cstr) r) + | Success r -> Success (coerce env (prop,cstr) r) | Fail | Identity -> res in state, res | _ -> state, Fail @@ -2144,7 +2112,7 @@ let setoid_proof ty fn fallback = let car = snd (List.hd (fst (Reductionops.splay_prod env sigma t))) in (try init_relation_classes () with _ -> raise Not_found); fn env sigma car rel - with e -> + with e when CErrors.noncritical e -> (* XXX what is the right test here as to whether e can be converted ? *) let e, info = Exninfo.capture e in Proofview.tclZERO ~info e diff --git a/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml index f7037176d2..ee28229cb7 100644 --- a/plugins/ltac/taccoerce.ml +++ b/plugins/ltac/taccoerce.ml @@ -161,8 +161,8 @@ let coerce_var_to_ident fresh env sigma v = match out_gen (topwit wit_intro_pattern) v with | { CAst.v=IntroNaming (IntroIdentifier id)} -> id | _ -> fail () - else if has_type v (topwit wit_var) then - out_gen (topwit wit_var) v + else if has_type v (topwit wit_hyp) then + out_gen (topwit wit_hyp) v else match Value.to_constr v with | None -> fail () | Some c -> @@ -184,8 +184,8 @@ let id_of_name = function | Some (IntroNaming (IntroIdentifier id)) -> id | Some _ -> fail () | None -> - if has_type v (topwit wit_var) then - out_gen (topwit wit_var) v + if has_type v (topwit wit_hyp) then + out_gen (topwit wit_hyp) v else match Value.to_constr v with | None -> fail () @@ -222,8 +222,8 @@ let coerce_to_intro_pattern sigma v = match is_intro_pattern v with | Some pat -> pat | None -> - if has_type v (topwit wit_var) then - let id = out_gen (topwit wit_var) v in + if has_type v (topwit wit_hyp) then + let id = out_gen (topwit wit_hyp) v in IntroNaming (IntroIdentifier id) else match Value.to_constr v with | Some c when isVar sigma c -> @@ -259,8 +259,8 @@ let coerce_to_constr env v = ([], c) else if has_type v (topwit wit_constr_under_binders) then out_gen (topwit wit_constr_under_binders) v - else if has_type v (topwit wit_var) then - let id = out_gen (topwit wit_var) v in + else if has_type v (topwit wit_hyp) then + let id = out_gen (topwit wit_hyp) v in (try [], constr_of_id env id with Not_found -> fail ()) else fail () @@ -282,8 +282,8 @@ let coerce_to_evaluable_ref env sigma v = | Some (IntroNaming (IntroIdentifier id)) when is_variable env id -> EvalVarRef id | Some _ -> fail () | None -> - if has_type v (topwit wit_var) then - let id = out_gen (topwit wit_var) v in + if has_type v (topwit wit_hyp) then + let id = out_gen (topwit wit_hyp) v in if Id.List.mem id (Termops.ids_of_context env) then EvalVarRef id else fail () else if has_type v (topwit wit_ref) then @@ -328,8 +328,8 @@ let coerce_to_hyp env sigma v = | Some (IntroNaming (IntroIdentifier id)) when is_variable env id -> id | Some _ -> fail () | None -> - if has_type v (topwit wit_var) then - let id = out_gen (topwit wit_var) v in + if has_type v (topwit wit_hyp) then + let id = out_gen (topwit wit_hyp) v in if is_variable env id then id else fail () else match Value.to_constr v with | Some c when isVar sigma c -> destVar sigma c @@ -360,8 +360,8 @@ let coerce_to_quantified_hypothesis sigma v = | Some (IntroNaming (IntroIdentifier id)) -> NamedHyp id | Some _ -> raise (CannotCoerceTo "a quantified hypothesis") | None -> - if has_type v (topwit wit_var) then - let id = out_gen (topwit wit_var) v in + if has_type v (topwit wit_hyp) then + let id = out_gen (topwit wit_hyp) v in NamedHyp id else if has_type v (topwit wit_int) then AnonHyp (out_gen (topwit wit_int) v) diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml index f0ca813b08..6823b6411f 100644 --- a/plugins/ltac/tacentries.ml +++ b/plugins/ltac/tacentries.ml @@ -31,18 +31,6 @@ type argument = Genarg.ArgT.any Extend.user_symbol (**********************************************************************) (* Interpret entry names of the form "ne_constr_list" as entry keys *) -let coincide s pat off = - let len = String.length pat in - let break = ref true in - let i = ref 0 in - while !break && !i < len do - let c = Char.code s.[off + !i] in - let d = Char.code pat.[!i] in - break := Int.equal c d; - incr i - done; - !break - let atactic n = if n = 5 then Pcoq.Symbol.nterm Pltac.binder_tactic else Pcoq.Symbol.nterml Pltac.tactic_expr (string_of_int n) @@ -70,28 +58,37 @@ let check_separator ?loc = function | Some _ -> user_err ?loc (str "Separator is only for arguments with suffix _list_sep.") let rec parse_user_entry ?loc s sep = - let l = String.length s in - if l > 8 && coincide s "ne_" 0 && coincide s "_list" (l - 5) then - let entry = parse_user_entry ?loc (String.sub s 3 (l-8)) None in + let open CString in + let matches pre suf s = + String.length s > (String.length pre + String.length suf) && + is_prefix pre s && is_suffix suf s + in + let basename pre suf s = + let plen = String.length pre in + String.sub s plen (String.length s - (plen + String.length suf)) + in + let tactic_len = String.length "tactic" in + if matches "ne_" "_list" s then + let entry = parse_user_entry ?loc (basename "ne_" "_list" s) None in check_separator ?loc sep; Ulist1 entry - else if l > 12 && coincide s "ne_" 0 && - coincide s "_list_sep" (l-9) then - let entry = parse_user_entry ?loc (String.sub s 3 (l-12)) None in + else if matches "ne_" "_list_sep" s then + let entry = parse_user_entry ?loc (basename "ne_" "_list_sep" s) None in Ulist1sep (entry, get_separator sep) - else if l > 5 && coincide s "_list" (l-5) then - let entry = parse_user_entry ?loc (String.sub s 0 (l-5)) None in + else if matches "" "_list" s then + let entry = parse_user_entry ?loc (basename "" "_list" s) None in check_separator ?loc sep; Ulist0 entry - else if l > 9 && coincide s "_list_sep" (l-9) then - let entry = parse_user_entry ?loc (String.sub s 0 (l-9)) None in + else if matches "" "_list_sep" s then + let entry = parse_user_entry ?loc (basename "" "_list_sep" s) None in Ulist0sep (entry, get_separator sep) - else if l > 4 && coincide s "_opt" (l-4) then - let entry = parse_user_entry ?loc (String.sub s 0 (l-4)) None in + else if matches "" "_opt" s then + let entry = parse_user_entry ?loc (basename "" "_opt" s) None in check_separator ?loc sep; Uopt entry - else if Int.equal l 7 && coincide s "tactic" 0 && '5' >= s.[6] && s.[6] >= '0' then - let n = Char.code s.[6] - 48 in + else if String.length s = tactic_len + 1 && is_prefix "tactic" s + && '5' >= s.[tactic_len] && s.[tactic_len] >= '0' then + let n = Char.code s.[tactic_len] - Char.code '0' in check_separator ?loc sep; Uentryl ("tactic", n) else @@ -159,7 +156,7 @@ let rec prod_item_of_symbol lev = function EntryName (Rawwit wit, Pcoq.Symbol.nterm (genarg_grammar wit)) | Extend.Uentryl (s, n) -> let ArgT.Any tag = s in - assert (coincide (ArgT.repr tag) "tactic" 0); + assert (CString.is_suffix "tactic" (ArgT.repr tag)); get_tacentry n lev (** Tactic grammar extensions *) @@ -219,7 +216,9 @@ let interp_prod_item = function | None -> if String.Map.mem s !entry_names then String.Map.find s !entry_names else begin match ArgT.name s with - | None -> user_err Pp.(str ("Unknown entry "^s^".")) + | None -> + if s = "var" then user_err Pp.(str ("var is deprecated, use hyp.")) (* to remove in 8.14 *) + else user_err Pp.(str ("Unknown entry "^s^".")) | Some arg -> arg end | Some n -> diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml index dea216045e..9c3b05fdf1 100644 --- a/plugins/ltac/tacintern.ml +++ b/plugins/ltac/tacintern.ml @@ -835,7 +835,7 @@ let () = Genintern.register_intern0 wit_ref (lift intern_global_reference); Genintern.register_intern0 wit_pre_ident (fun ist c -> (ist,c)); Genintern.register_intern0 wit_ident intern_ident'; - Genintern.register_intern0 wit_var (lift intern_hyp); + Genintern.register_intern0 wit_hyp (lift intern_hyp); Genintern.register_intern0 wit_tactic (lift intern_tactic_or_tacarg); Genintern.register_intern0 wit_ltac (lift intern_ltac); Genintern.register_intern0 wit_quant_hyp (lift intern_quantified_hypothesis); diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml index ff6a36a049..12bfb4d09e 100644 --- a/plugins/ltac/tacinterp.ml +++ b/plugins/ltac/tacinterp.ml @@ -971,8 +971,8 @@ let interp_destruction_arg ist gl arg = match v with | {v=IntroNaming (IntroIdentifier id)} -> try_cast_id id | _ -> error () - else if has_type v (topwit wit_var) then - let id = out_gen (topwit wit_var) v in + else if has_type v (topwit wit_hyp) then + let id = out_gen (topwit wit_hyp) v in try_cast_id id else if has_type v (topwit wit_int) then keep,ElimOnAnonHyp (out_gen (topwit wit_int) v) @@ -1238,7 +1238,7 @@ and interp_ltac_reference ?loc' mustbetac ist r : Val.t Ftactic.t = | ArgVar {loc;v=id} -> let v = try Id.Map.find id ist.lfun - with Not_found -> in_gen (topwit wit_var) id + with Not_found -> in_gen (topwit wit_hyp) id in let open Ftactic in force_vrec ist v >>= begin fun v -> @@ -1529,7 +1529,7 @@ and interp_genarg ist x : Val.t Ftactic.t = let open Ftactic.Notations in (* Ad-hoc handling of some types. *) let tag = genarg_tag x in - if argument_type_eq tag (unquote (topwit (wit_list wit_var))) then + if argument_type_eq tag (unquote (topwit (wit_list wit_hyp))) then interp_genarg_var_list ist x else if argument_type_eq tag (unquote (topwit (wit_list wit_constr))) then interp_genarg_constr_list ist x @@ -1573,9 +1573,9 @@ and interp_genarg_var_list ist x = Ftactic.enter begin fun gl -> let env = Proofview.Goal.env gl in let sigma = Proofview.Goal.sigma gl in - let lc = Genarg.out_gen (glbwit (wit_list wit_var)) x in + let lc = Genarg.out_gen (glbwit (wit_list wit_hyp)) x in let lc = interp_hyp_list ist env sigma lc in - let lc = in_list (val_tag wit_var) lc in + let lc = in_list (val_tag wit_hyp) lc in Ftactic.return lc end @@ -1996,16 +1996,20 @@ let interp_tac_gen lfun avoid_ids debug t = let interp t = interp_tac_gen Id.Map.empty Id.Set.empty (get_debug()) t +(* MUST be marshallable! *) +type tactic_expr = { + global: bool; + ast: Tacexpr.raw_tactic_expr; +} + (* Used to hide interpretation for pretty-print, now just launch tactics *) (* [global] means that [t] should be internalized outside of goals. *) -let hide_interp global t ot = +let hide_interp {global;ast} = let hide_interp env = let ist = Genintern.empty_glob_sign env in - let te = intern_pure_tactic ist t in + let te = intern_pure_tactic ist ast in let t = eval_tactic te in - match ot with - | None -> t - | Some t' -> Tacticals.New.tclTHEN t t' + t in if global then Proofview.tclENV >>= fun env -> @@ -2015,6 +2019,8 @@ let hide_interp global t ot = hide_interp (Proofview.Goal.env gl) end +let hide_interp = ComTactic.register_tactic_interpreter "ltac1" hide_interp + (***************************************************************************) (** Register standard arguments *) @@ -2090,7 +2096,7 @@ let () = register_interp0 wit_ref (lift interp_reference); register_interp0 wit_pre_ident (lift interp_pre_ident); register_interp0 wit_ident (lift interp_ident); - register_interp0 wit_var (lift interp_hyp); + register_interp0 wit_hyp (lift interp_hyp); register_interp0 wit_intropattern (lifts interp_intro_pattern) [@warning "-3"]; register_interp0 wit_simple_intropattern (lifts interp_intro_pattern); register_interp0 wit_clause_dft_concl (lift interp_clause); diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli index cbb17bf0fa..01d7306c9d 100644 --- a/plugins/ltac/tacinterp.mli +++ b/plugins/ltac/tacinterp.mli @@ -126,8 +126,12 @@ val interp_tac_gen : value Id.Map.t -> Id.Set.t -> val interp : raw_tactic_expr -> unit Proofview.tactic (** Hides interpretation for pretty-print *) +type tactic_expr = { + global: bool; + ast: Tacexpr.raw_tactic_expr; +} -val hide_interp : bool -> raw_tactic_expr -> unit Proofview.tactic option -> unit Proofview.tactic +val hide_interp : tactic_expr ComTactic.tactic_interpreter (** Internals that can be useful for syntax extensions. *) diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml index fd869b225f..ec44ae4698 100644 --- a/plugins/ltac/tacsubst.ml +++ b/plugins/ltac/tacsubst.ml @@ -282,7 +282,7 @@ let () = Genintern.register_subst0 wit_smart_global subst_global_reference; Genintern.register_subst0 wit_pre_ident (fun _ v -> v); Genintern.register_subst0 wit_ident (fun _ v -> v); - Genintern.register_subst0 wit_var (fun _ v -> v); + Genintern.register_subst0 wit_hyp (fun _ v -> v); Genintern.register_subst0 wit_intropattern subst_intro_pattern [@warning "-3"]; Genintern.register_subst0 wit_simple_intropattern subst_intro_pattern; Genintern.register_subst0 wit_tactic subst_tactic; diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml index d2c49c4432..542b99075d 100644 --- a/plugins/micromega/coq_micromega.ml +++ b/plugins/micromega/coq_micromega.ml @@ -134,166 +134,161 @@ let selecti s m = *) (** - * MODULE END: M - *) -module M = struct - (** * Initialization : a large amount of Caml symbols are derived from * ZMicromega.v *) - let constr_of_ref str = - EConstr.of_constr - (UnivGen.constr_of_monomorphic_global (Coqlib.lib_ref str)) - - let coq_and = lazy (constr_of_ref "core.and.type") - let coq_or = lazy (constr_of_ref "core.or.type") - let coq_not = lazy (constr_of_ref "core.not.type") - let coq_iff = lazy (constr_of_ref "core.iff.type") - let coq_True = lazy (constr_of_ref "core.True.type") - let coq_False = lazy (constr_of_ref "core.False.type") - let coq_bool = lazy (constr_of_ref "core.bool.type") - let coq_true = lazy (constr_of_ref "core.bool.true") - let coq_false = lazy (constr_of_ref "core.bool.false") - let coq_andb = lazy (constr_of_ref "core.bool.andb") - let coq_orb = lazy (constr_of_ref "core.bool.orb") - let coq_implb = lazy (constr_of_ref "core.bool.implb") - let coq_eqb = lazy (constr_of_ref "core.bool.eqb") - let coq_negb = lazy (constr_of_ref "core.bool.negb") - let coq_cons = lazy (constr_of_ref "core.list.cons") - let coq_nil = lazy (constr_of_ref "core.list.nil") - let coq_list = lazy (constr_of_ref "core.list.type") - let coq_O = lazy (constr_of_ref "num.nat.O") - let coq_S = lazy (constr_of_ref "num.nat.S") - let coq_nat = lazy (constr_of_ref "num.nat.type") - let coq_unit = lazy (constr_of_ref "core.unit.type") - - (* let coq_option = lazy (init_constant "option")*) - let coq_None = lazy (constr_of_ref "core.option.None") - let coq_tt = lazy (constr_of_ref "core.unit.tt") - let coq_Inl = lazy (constr_of_ref "core.sum.inl") - let coq_Inr = lazy (constr_of_ref "core.sum.inr") - let coq_N0 = lazy (constr_of_ref "num.N.N0") - let coq_Npos = lazy (constr_of_ref "num.N.Npos") - let coq_xH = lazy (constr_of_ref "num.pos.xH") - let coq_xO = lazy (constr_of_ref "num.pos.xO") - let coq_xI = lazy (constr_of_ref "num.pos.xI") - let coq_Z = lazy (constr_of_ref "num.Z.type") - let coq_ZERO = lazy (constr_of_ref "num.Z.Z0") - let coq_POS = lazy (constr_of_ref "num.Z.Zpos") - let coq_NEG = lazy (constr_of_ref "num.Z.Zneg") - let coq_Q = lazy (constr_of_ref "rat.Q.type") - let coq_Qmake = lazy (constr_of_ref "rat.Q.Qmake") - let coq_R = lazy (constr_of_ref "reals.R.type") - let coq_Rcst = lazy (constr_of_ref "micromega.Rcst.type") - let coq_C0 = lazy (constr_of_ref "micromega.Rcst.C0") - let coq_C1 = lazy (constr_of_ref "micromega.Rcst.C1") - let coq_CQ = lazy (constr_of_ref "micromega.Rcst.CQ") - let coq_CZ = lazy (constr_of_ref "micromega.Rcst.CZ") - let coq_CPlus = lazy (constr_of_ref "micromega.Rcst.CPlus") - let coq_CMinus = lazy (constr_of_ref "micromega.Rcst.CMinus") - let coq_CMult = lazy (constr_of_ref "micromega.Rcst.CMult") - let coq_CPow = lazy (constr_of_ref "micromega.Rcst.CPow") - let coq_CInv = lazy (constr_of_ref "micromega.Rcst.CInv") - let coq_COpp = lazy (constr_of_ref "micromega.Rcst.COpp") - let coq_R0 = lazy (constr_of_ref "reals.R.R0") - let coq_R1 = lazy (constr_of_ref "reals.R.R1") - let coq_proofTerm = lazy (constr_of_ref "micromega.ZArithProof.type") - let coq_doneProof = lazy (constr_of_ref "micromega.ZArithProof.DoneProof") - let coq_ratProof = lazy (constr_of_ref "micromega.ZArithProof.RatProof") - let coq_cutProof = lazy (constr_of_ref "micromega.ZArithProof.CutProof") - let coq_enumProof = lazy (constr_of_ref "micromega.ZArithProof.EnumProof") - let coq_ExProof = lazy (constr_of_ref "micromega.ZArithProof.ExProof") - let coq_IsProp = lazy (constr_of_ref "micromega.kind.isProp") - let coq_IsBool = lazy (constr_of_ref "micromega.kind.isBool") - let coq_Zgt = lazy (constr_of_ref "num.Z.gt") - let coq_Zge = lazy (constr_of_ref "num.Z.ge") - let coq_Zle = lazy (constr_of_ref "num.Z.le") - let coq_Zlt = lazy (constr_of_ref "num.Z.lt") - let coq_Zgtb = lazy (constr_of_ref "num.Z.gtb") - let coq_Zgeb = lazy (constr_of_ref "num.Z.geb") - let coq_Zleb = lazy (constr_of_ref "num.Z.leb") - let coq_Zltb = lazy (constr_of_ref "num.Z.ltb") - let coq_Zeqb = lazy (constr_of_ref "num.Z.eqb") - let coq_eq = lazy (constr_of_ref "core.eq.type") - let coq_Zplus = lazy (constr_of_ref "num.Z.add") - let coq_Zminus = lazy (constr_of_ref "num.Z.sub") - let coq_Zopp = lazy (constr_of_ref "num.Z.opp") - let coq_Zmult = lazy (constr_of_ref "num.Z.mul") - let coq_Zpower = lazy (constr_of_ref "num.Z.pow") - let coq_Qle = lazy (constr_of_ref "rat.Q.Qle") - let coq_Qlt = lazy (constr_of_ref "rat.Q.Qlt") - let coq_Qeq = lazy (constr_of_ref "rat.Q.Qeq") - let coq_Qplus = lazy (constr_of_ref "rat.Q.Qplus") - let coq_Qminus = lazy (constr_of_ref "rat.Q.Qminus") - let coq_Qopp = lazy (constr_of_ref "rat.Q.Qopp") - let coq_Qmult = lazy (constr_of_ref "rat.Q.Qmult") - let coq_Qpower = lazy (constr_of_ref "rat.Q.Qpower") - let coq_Rgt = lazy (constr_of_ref "reals.R.Rgt") - let coq_Rge = lazy (constr_of_ref "reals.R.Rge") - let coq_Rle = lazy (constr_of_ref "reals.R.Rle") - let coq_Rlt = lazy (constr_of_ref "reals.R.Rlt") - let coq_Rplus = lazy (constr_of_ref "reals.R.Rplus") - let coq_Rminus = lazy (constr_of_ref "reals.R.Rminus") - let coq_Ropp = lazy (constr_of_ref "reals.R.Ropp") - let coq_Rmult = lazy (constr_of_ref "reals.R.Rmult") - let coq_Rinv = lazy (constr_of_ref "reals.R.Rinv") - let coq_Rpower = lazy (constr_of_ref "reals.R.pow") - let coq_powerZR = lazy (constr_of_ref "reals.R.powerRZ") - let coq_IZR = lazy (constr_of_ref "reals.R.IZR") - let coq_IQR = lazy (constr_of_ref "reals.R.Q2R") - let coq_PEX = lazy (constr_of_ref "micromega.PExpr.PEX") - let coq_PEc = lazy (constr_of_ref "micromega.PExpr.PEc") - let coq_PEadd = lazy (constr_of_ref "micromega.PExpr.PEadd") - let coq_PEopp = lazy (constr_of_ref "micromega.PExpr.PEopp") - let coq_PEmul = lazy (constr_of_ref "micromega.PExpr.PEmul") - let coq_PEsub = lazy (constr_of_ref "micromega.PExpr.PEsub") - let coq_PEpow = lazy (constr_of_ref "micromega.PExpr.PEpow") - let coq_PX = lazy (constr_of_ref "micromega.Pol.PX") - let coq_Pc = lazy (constr_of_ref "micromega.Pol.Pc") - let coq_Pinj = lazy (constr_of_ref "micromega.Pol.Pinj") - let coq_OpEq = lazy (constr_of_ref "micromega.Op2.OpEq") - let coq_OpNEq = lazy (constr_of_ref "micromega.Op2.OpNEq") - let coq_OpLe = lazy (constr_of_ref "micromega.Op2.OpLe") - let coq_OpLt = lazy (constr_of_ref "micromega.Op2.OpLt") - let coq_OpGe = lazy (constr_of_ref "micromega.Op2.OpGe") - let coq_OpGt = lazy (constr_of_ref "micromega.Op2.OpGt") - let coq_PsatzIn = lazy (constr_of_ref "micromega.Psatz.PsatzIn") - let coq_PsatzSquare = lazy (constr_of_ref "micromega.Psatz.PsatzSquare") - let coq_PsatzMulE = lazy (constr_of_ref "micromega.Psatz.PsatzMulE") - let coq_PsatzMultC = lazy (constr_of_ref "micromega.Psatz.PsatzMulC") - let coq_PsatzAdd = lazy (constr_of_ref "micromega.Psatz.PsatzAdd") - let coq_PsatzC = lazy (constr_of_ref "micromega.Psatz.PsatzC") - let coq_PsatzZ = lazy (constr_of_ref "micromega.Psatz.PsatzZ") - - (* let coq_GT = lazy (m_constant "GT")*) - - let coq_DeclaredConstant = - lazy (constr_of_ref "micromega.DeclaredConstant.type") - - let coq_TT = lazy (constr_of_ref "micromega.GFormula.TT") - let coq_FF = lazy (constr_of_ref "micromega.GFormula.FF") - let coq_AND = lazy (constr_of_ref "micromega.GFormula.AND") - let coq_OR = lazy (constr_of_ref "micromega.GFormula.OR") - let coq_NOT = lazy (constr_of_ref "micromega.GFormula.NOT") - let coq_Atom = lazy (constr_of_ref "micromega.GFormula.A") - let coq_X = lazy (constr_of_ref "micromega.GFormula.X") - let coq_IMPL = lazy (constr_of_ref "micromega.GFormula.IMPL") - let coq_IFF = lazy (constr_of_ref "micromega.GFormula.IFF") - let coq_EQ = lazy (constr_of_ref "micromega.GFormula.EQ") - let coq_Formula = lazy (constr_of_ref "micromega.BFormula.type") - let coq_eKind = lazy (constr_of_ref "micromega.eKind") - - (** +let constr_of_ref str = + EConstr.of_constr (UnivGen.constr_of_monomorphic_global (Coqlib.lib_ref str)) + +let coq_and = lazy (constr_of_ref "core.and.type") +let coq_or = lazy (constr_of_ref "core.or.type") +let coq_not = lazy (constr_of_ref "core.not.type") +let coq_iff = lazy (constr_of_ref "core.iff.type") +let coq_True = lazy (constr_of_ref "core.True.type") +let coq_False = lazy (constr_of_ref "core.False.type") +let coq_bool = lazy (constr_of_ref "core.bool.type") +let coq_true = lazy (constr_of_ref "core.bool.true") +let coq_false = lazy (constr_of_ref "core.bool.false") +let coq_andb = lazy (constr_of_ref "core.bool.andb") +let coq_orb = lazy (constr_of_ref "core.bool.orb") +let coq_implb = lazy (constr_of_ref "core.bool.implb") +let coq_eqb = lazy (constr_of_ref "core.bool.eqb") +let coq_negb = lazy (constr_of_ref "core.bool.negb") +let coq_cons = lazy (constr_of_ref "core.list.cons") +let coq_nil = lazy (constr_of_ref "core.list.nil") +let coq_list = lazy (constr_of_ref "core.list.type") +let coq_O = lazy (constr_of_ref "num.nat.O") +let coq_S = lazy (constr_of_ref "num.nat.S") +let coq_nat = lazy (constr_of_ref "num.nat.type") +let coq_unit = lazy (constr_of_ref "core.unit.type") + +(* let coq_option = lazy (init_constant "option")*) +let coq_None = lazy (constr_of_ref "core.option.None") +let coq_tt = lazy (constr_of_ref "core.unit.tt") +let coq_Inl = lazy (constr_of_ref "core.sum.inl") +let coq_Inr = lazy (constr_of_ref "core.sum.inr") +let coq_N0 = lazy (constr_of_ref "num.N.N0") +let coq_Npos = lazy (constr_of_ref "num.N.Npos") +let coq_xH = lazy (constr_of_ref "num.pos.xH") +let coq_xO = lazy (constr_of_ref "num.pos.xO") +let coq_xI = lazy (constr_of_ref "num.pos.xI") +let coq_Z = lazy (constr_of_ref "num.Z.type") +let coq_ZERO = lazy (constr_of_ref "num.Z.Z0") +let coq_POS = lazy (constr_of_ref "num.Z.Zpos") +let coq_NEG = lazy (constr_of_ref "num.Z.Zneg") +let coq_Q = lazy (constr_of_ref "rat.Q.type") +let coq_Qmake = lazy (constr_of_ref "rat.Q.Qmake") +let coq_R = lazy (constr_of_ref "reals.R.type") +let coq_Rcst = lazy (constr_of_ref "micromega.Rcst.type") +let coq_C0 = lazy (constr_of_ref "micromega.Rcst.C0") +let coq_C1 = lazy (constr_of_ref "micromega.Rcst.C1") +let coq_CQ = lazy (constr_of_ref "micromega.Rcst.CQ") +let coq_CZ = lazy (constr_of_ref "micromega.Rcst.CZ") +let coq_CPlus = lazy (constr_of_ref "micromega.Rcst.CPlus") +let coq_CMinus = lazy (constr_of_ref "micromega.Rcst.CMinus") +let coq_CMult = lazy (constr_of_ref "micromega.Rcst.CMult") +let coq_CPow = lazy (constr_of_ref "micromega.Rcst.CPow") +let coq_CInv = lazy (constr_of_ref "micromega.Rcst.CInv") +let coq_COpp = lazy (constr_of_ref "micromega.Rcst.COpp") +let coq_R0 = lazy (constr_of_ref "reals.R.R0") +let coq_R1 = lazy (constr_of_ref "reals.R.R1") +let coq_proofTerm = lazy (constr_of_ref "micromega.ZArithProof.type") +let coq_doneProof = lazy (constr_of_ref "micromega.ZArithProof.DoneProof") +let coq_ratProof = lazy (constr_of_ref "micromega.ZArithProof.RatProof") +let coq_cutProof = lazy (constr_of_ref "micromega.ZArithProof.CutProof") +let coq_enumProof = lazy (constr_of_ref "micromega.ZArithProof.EnumProof") +let coq_ExProof = lazy (constr_of_ref "micromega.ZArithProof.ExProof") +let coq_IsProp = lazy (constr_of_ref "micromega.kind.isProp") +let coq_IsBool = lazy (constr_of_ref "micromega.kind.isBool") +let coq_Zgt = lazy (constr_of_ref "num.Z.gt") +let coq_Zge = lazy (constr_of_ref "num.Z.ge") +let coq_Zle = lazy (constr_of_ref "num.Z.le") +let coq_Zlt = lazy (constr_of_ref "num.Z.lt") +let coq_Zgtb = lazy (constr_of_ref "num.Z.gtb") +let coq_Zgeb = lazy (constr_of_ref "num.Z.geb") +let coq_Zleb = lazy (constr_of_ref "num.Z.leb") +let coq_Zltb = lazy (constr_of_ref "num.Z.ltb") +let coq_Zeqb = lazy (constr_of_ref "num.Z.eqb") +let coq_eq = lazy (constr_of_ref "core.eq.type") +let coq_Zplus = lazy (constr_of_ref "num.Z.add") +let coq_Zminus = lazy (constr_of_ref "num.Z.sub") +let coq_Zopp = lazy (constr_of_ref "num.Z.opp") +let coq_Zmult = lazy (constr_of_ref "num.Z.mul") +let coq_Zpower = lazy (constr_of_ref "num.Z.pow") +let coq_Qle = lazy (constr_of_ref "rat.Q.Qle") +let coq_Qlt = lazy (constr_of_ref "rat.Q.Qlt") +let coq_Qeq = lazy (constr_of_ref "rat.Q.Qeq") +let coq_Qplus = lazy (constr_of_ref "rat.Q.Qplus") +let coq_Qminus = lazy (constr_of_ref "rat.Q.Qminus") +let coq_Qopp = lazy (constr_of_ref "rat.Q.Qopp") +let coq_Qmult = lazy (constr_of_ref "rat.Q.Qmult") +let coq_Qpower = lazy (constr_of_ref "rat.Q.Qpower") +let coq_Rgt = lazy (constr_of_ref "reals.R.Rgt") +let coq_Rge = lazy (constr_of_ref "reals.R.Rge") +let coq_Rle = lazy (constr_of_ref "reals.R.Rle") +let coq_Rlt = lazy (constr_of_ref "reals.R.Rlt") +let coq_Rplus = lazy (constr_of_ref "reals.R.Rplus") +let coq_Rminus = lazy (constr_of_ref "reals.R.Rminus") +let coq_Ropp = lazy (constr_of_ref "reals.R.Ropp") +let coq_Rmult = lazy (constr_of_ref "reals.R.Rmult") +let coq_Rinv = lazy (constr_of_ref "reals.R.Rinv") +let coq_Rpower = lazy (constr_of_ref "reals.R.pow") +let coq_powerZR = lazy (constr_of_ref "reals.R.powerRZ") +let coq_IZR = lazy (constr_of_ref "reals.R.IZR") +let coq_IQR = lazy (constr_of_ref "reals.R.Q2R") +let coq_PEX = lazy (constr_of_ref "micromega.PExpr.PEX") +let coq_PEc = lazy (constr_of_ref "micromega.PExpr.PEc") +let coq_PEadd = lazy (constr_of_ref "micromega.PExpr.PEadd") +let coq_PEopp = lazy (constr_of_ref "micromega.PExpr.PEopp") +let coq_PEmul = lazy (constr_of_ref "micromega.PExpr.PEmul") +let coq_PEsub = lazy (constr_of_ref "micromega.PExpr.PEsub") +let coq_PEpow = lazy (constr_of_ref "micromega.PExpr.PEpow") +let coq_PX = lazy (constr_of_ref "micromega.Pol.PX") +let coq_Pc = lazy (constr_of_ref "micromega.Pol.Pc") +let coq_Pinj = lazy (constr_of_ref "micromega.Pol.Pinj") +let coq_OpEq = lazy (constr_of_ref "micromega.Op2.OpEq") +let coq_OpNEq = lazy (constr_of_ref "micromega.Op2.OpNEq") +let coq_OpLe = lazy (constr_of_ref "micromega.Op2.OpLe") +let coq_OpLt = lazy (constr_of_ref "micromega.Op2.OpLt") +let coq_OpGe = lazy (constr_of_ref "micromega.Op2.OpGe") +let coq_OpGt = lazy (constr_of_ref "micromega.Op2.OpGt") +let coq_PsatzIn = lazy (constr_of_ref "micromega.Psatz.PsatzIn") +let coq_PsatzSquare = lazy (constr_of_ref "micromega.Psatz.PsatzSquare") +let coq_PsatzMulE = lazy (constr_of_ref "micromega.Psatz.PsatzMulE") +let coq_PsatzMultC = lazy (constr_of_ref "micromega.Psatz.PsatzMulC") +let coq_PsatzAdd = lazy (constr_of_ref "micromega.Psatz.PsatzAdd") +let coq_PsatzC = lazy (constr_of_ref "micromega.Psatz.PsatzC") +let coq_PsatzZ = lazy (constr_of_ref "micromega.Psatz.PsatzZ") + +(* let coq_GT = lazy (m_constant "GT")*) + +let coq_DeclaredConstant = + lazy (constr_of_ref "micromega.DeclaredConstant.type") + +let coq_TT = lazy (constr_of_ref "micromega.GFormula.TT") +let coq_FF = lazy (constr_of_ref "micromega.GFormula.FF") +let coq_AND = lazy (constr_of_ref "micromega.GFormula.AND") +let coq_OR = lazy (constr_of_ref "micromega.GFormula.OR") +let coq_NOT = lazy (constr_of_ref "micromega.GFormula.NOT") +let coq_Atom = lazy (constr_of_ref "micromega.GFormula.A") +let coq_X = lazy (constr_of_ref "micromega.GFormula.X") +let coq_IMPL = lazy (constr_of_ref "micromega.GFormula.IMPL") +let coq_IFF = lazy (constr_of_ref "micromega.GFormula.IFF") +let coq_EQ = lazy (constr_of_ref "micromega.GFormula.EQ") +let coq_Formula = lazy (constr_of_ref "micromega.BFormula.type") +let coq_eKind = lazy (constr_of_ref "micromega.eKind") + +(** * Initialization : a few Caml symbols are derived from other libraries; * QMicromega, ZArithRing, RingMicromega. *) - let coq_QWitness = lazy (constr_of_ref "micromega.QWitness.type") - let coq_Build = lazy (constr_of_ref "micromega.Formula.Build_Formula") - let coq_Cstr = lazy (constr_of_ref "micromega.Formula.type") +let coq_QWitness = lazy (constr_of_ref "micromega.QWitness.type") +let coq_Build = lazy (constr_of_ref "micromega.Formula.Build_Formula") +let coq_Cstr = lazy (constr_of_ref "micromega.Formula.type") - (** +(** * Parsing and dumping : transformation functions between Caml and Coq * data-structures. * @@ -302,1048 +297,1018 @@ module M = struct * pp_* functions pretty-print Coq terms. *) - exception ParseError +exception ParseError - (* A simple but useful getter function *) +(* A simple but useful getter function *) - let get_left_construct sigma term = - match EConstr.kind sigma term with - | Construct ((_, i), _) -> (i, [||]) - | App (l, rst) -> ( - match EConstr.kind sigma l with - | Construct ((_, i), _) -> (i, rst) - | _ -> raise ParseError ) - | _ -> raise ParseError +let get_left_construct sigma term = + match EConstr.kind sigma term with + | Construct ((_, i), _) -> (i, [||]) + | App (l, rst) -> ( + match EConstr.kind sigma l with + | Construct ((_, i), _) -> (i, rst) + | _ -> raise ParseError ) + | _ -> raise ParseError - (* Access the Micromega module *) +(* Access the Micromega module *) - (* parse/dump/print from numbers up to expressions and formulas *) +(* parse/dump/print from numbers up to expressions and formulas *) - let rec parse_nat sigma term = - let i, c = get_left_construct sigma term in - match i with - | 1 -> Mc.O - | 2 -> Mc.S (parse_nat sigma c.(0)) - | i -> raise ParseError +let rec parse_nat sigma term = + let i, c = get_left_construct sigma term in + match i with + | 1 -> Mc.O + | 2 -> Mc.S (parse_nat sigma c.(0)) + | i -> raise ParseError - let pp_nat o n = Printf.fprintf o "%i" (CoqToCaml.nat n) +let pp_nat o n = Printf.fprintf o "%i" (CoqToCaml.nat n) - let rec dump_nat x = - match x with - | Mc.O -> Lazy.force coq_O - | Mc.S p -> EConstr.mkApp (Lazy.force coq_S, [|dump_nat p|]) +let rec dump_nat x = + match x with + | Mc.O -> Lazy.force coq_O + | Mc.S p -> EConstr.mkApp (Lazy.force coq_S, [|dump_nat p|]) - let rec parse_positive sigma term = - let i, c = get_left_construct sigma term in - match i with - | 1 -> Mc.XI (parse_positive sigma c.(0)) - | 2 -> Mc.XO (parse_positive sigma c.(0)) - | 3 -> Mc.XH - | i -> raise ParseError +let rec parse_positive sigma term = + let i, c = get_left_construct sigma term in + match i with + | 1 -> Mc.XI (parse_positive sigma c.(0)) + | 2 -> Mc.XO (parse_positive sigma c.(0)) + | 3 -> Mc.XH + | i -> raise ParseError - let rec dump_positive x = - match x with - | Mc.XH -> Lazy.force coq_xH - | Mc.XO p -> EConstr.mkApp (Lazy.force coq_xO, [|dump_positive p|]) - | Mc.XI p -> EConstr.mkApp (Lazy.force coq_xI, [|dump_positive p|]) +let rec dump_positive x = + match x with + | Mc.XH -> Lazy.force coq_xH + | Mc.XO p -> EConstr.mkApp (Lazy.force coq_xO, [|dump_positive p|]) + | Mc.XI p -> EConstr.mkApp (Lazy.force coq_xI, [|dump_positive p|]) - let pp_positive o x = Printf.fprintf o "%i" (CoqToCaml.positive x) +let pp_positive o x = Printf.fprintf o "%i" (CoqToCaml.positive x) - let dump_n x = - match x with - | Mc.N0 -> Lazy.force coq_N0 - | Mc.Npos p -> EConstr.mkApp (Lazy.force coq_Npos, [|dump_positive p|]) +let dump_n x = + match x with + | Mc.N0 -> Lazy.force coq_N0 + | Mc.Npos p -> EConstr.mkApp (Lazy.force coq_Npos, [|dump_positive p|]) - (** [is_ground_term env sigma term] holds if the term [term] +(** [is_ground_term env sigma term] holds if the term [term] is an instance of the typeclass [DeclConstant.GT term] i.e. built from user-defined constants and functions. NB: This mechanism can be used to customise the reification process to decide what to consider as a constant (see [parse_constant]) *) - let is_declared_term env evd t = - match EConstr.kind evd t with - | Const _ | Construct _ -> ( - (* Restrict typeclass resolution to trivial cases *) - let typ = Retyping.get_type_of env evd t in - try - ignore - (Typeclasses.resolve_one_typeclass env evd - (EConstr.mkApp (Lazy.force coq_DeclaredConstant, [|typ; t|]))); - true - with Not_found -> false ) - | _ -> false - - let rec is_ground_term env evd term = - match EConstr.kind evd term with - | App (c, args) -> - is_declared_term env evd c && Array.for_all (is_ground_term env evd) args - | Const _ | Construct _ -> is_declared_term env evd term - | _ -> false - - let parse_z sigma term = - let i, c = get_left_construct sigma term in - match i with - | 1 -> Mc.Z0 - | 2 -> Mc.Zpos (parse_positive sigma c.(0)) - | 3 -> Mc.Zneg (parse_positive sigma c.(0)) - | i -> raise ParseError - - let dump_z x = - match x with - | Mc.Z0 -> Lazy.force coq_ZERO - | Mc.Zpos p -> EConstr.mkApp (Lazy.force coq_POS, [|dump_positive p|]) - | Mc.Zneg p -> EConstr.mkApp (Lazy.force coq_NEG, [|dump_positive p|]) - - let pp_z o x = - Printf.fprintf o "%s" (NumCompat.Z.to_string (CoqToCaml.z_big_int x)) - - let dump_q q = +let is_declared_term env evd t = + match EConstr.kind evd t with + | Const _ | Construct _ -> ( + (* Restrict typeclass resolution to trivial cases *) + let typ = Retyping.get_type_of env evd t in + try + ignore + (Typeclasses.resolve_one_typeclass env evd + (EConstr.mkApp (Lazy.force coq_DeclaredConstant, [|typ; t|]))); + true + with Not_found -> false ) + | _ -> false + +let rec is_ground_term env evd term = + match EConstr.kind evd term with + | App (c, args) -> + is_declared_term env evd c && Array.for_all (is_ground_term env evd) args + | Const _ | Construct _ -> is_declared_term env evd term + | _ -> false + +let parse_z sigma term = + let i, c = get_left_construct sigma term in + match i with + | 1 -> Mc.Z0 + | 2 -> Mc.Zpos (parse_positive sigma c.(0)) + | 3 -> Mc.Zneg (parse_positive sigma c.(0)) + | i -> raise ParseError + +let dump_z x = + match x with + | Mc.Z0 -> Lazy.force coq_ZERO + | Mc.Zpos p -> EConstr.mkApp (Lazy.force coq_POS, [|dump_positive p|]) + | Mc.Zneg p -> EConstr.mkApp (Lazy.force coq_NEG, [|dump_positive p|]) + +let pp_z o x = + Printf.fprintf o "%s" (NumCompat.Z.to_string (CoqToCaml.z_big_int x)) + +let dump_q q = + EConstr.mkApp + ( Lazy.force coq_Qmake + , [|dump_z q.Micromega.qnum; dump_positive q.Micromega.qden|] ) + +let parse_q sigma term = + match EConstr.kind sigma term with + | App (c, args) -> + if EConstr.eq_constr sigma c (Lazy.force coq_Qmake) then + {Mc.qnum = parse_z sigma args.(0); Mc.qden = parse_positive sigma args.(1)} + else raise ParseError + | _ -> raise ParseError + +let rec pp_Rcst o cst = + match cst with + | Mc.C0 -> output_string o "C0" + | Mc.C1 -> output_string o "C1" + | Mc.CQ q -> output_string o "CQ _" + | Mc.CZ z -> pp_z o z + | Mc.CPlus (x, y) -> Printf.fprintf o "(%a + %a)" pp_Rcst x pp_Rcst y + | Mc.CMinus (x, y) -> Printf.fprintf o "(%a - %a)" pp_Rcst x pp_Rcst y + | Mc.CMult (x, y) -> Printf.fprintf o "(%a * %a)" pp_Rcst x pp_Rcst y + | Mc.CPow (x, y) -> Printf.fprintf o "(%a ^ _)" pp_Rcst x + | Mc.CInv t -> Printf.fprintf o "(/ %a)" pp_Rcst t + | Mc.COpp t -> Printf.fprintf o "(- %a)" pp_Rcst t + +let rec dump_Rcst cst = + match cst with + | Mc.C0 -> Lazy.force coq_C0 + | Mc.C1 -> Lazy.force coq_C1 + | Mc.CQ q -> EConstr.mkApp (Lazy.force coq_CQ, [|dump_q q|]) + | Mc.CZ z -> EConstr.mkApp (Lazy.force coq_CZ, [|dump_z z|]) + | Mc.CPlus (x, y) -> + EConstr.mkApp (Lazy.force coq_CPlus, [|dump_Rcst x; dump_Rcst y|]) + | Mc.CMinus (x, y) -> + EConstr.mkApp (Lazy.force coq_CMinus, [|dump_Rcst x; dump_Rcst y|]) + | Mc.CMult (x, y) -> + EConstr.mkApp (Lazy.force coq_CMult, [|dump_Rcst x; dump_Rcst y|]) + | Mc.CPow (x, y) -> EConstr.mkApp - ( Lazy.force coq_Qmake - , [|dump_z q.Micromega.qnum; dump_positive q.Micromega.qden|] ) - - let parse_q sigma term = - match EConstr.kind sigma term with - | App (c, args) -> - if EConstr.eq_constr sigma c (Lazy.force coq_Qmake) then - { Mc.qnum = parse_z sigma args.(0) - ; Mc.qden = parse_positive sigma args.(1) } - else raise ParseError - | _ -> raise ParseError + ( Lazy.force coq_CPow + , [| dump_Rcst x + ; ( match y with + | Mc.Inl z -> + EConstr.mkApp + ( Lazy.force coq_Inl + , [|Lazy.force coq_Z; Lazy.force coq_nat; dump_z z|] ) + | Mc.Inr n -> + EConstr.mkApp + ( Lazy.force coq_Inr + , [|Lazy.force coq_Z; Lazy.force coq_nat; dump_nat n|] ) ) |] ) + | Mc.CInv t -> EConstr.mkApp (Lazy.force coq_CInv, [|dump_Rcst t|]) + | Mc.COpp t -> EConstr.mkApp (Lazy.force coq_COpp, [|dump_Rcst t|]) + +let rec dump_list typ dump_elt l = + match l with + | [] -> EConstr.mkApp (Lazy.force coq_nil, [|typ|]) + | e :: l -> + EConstr.mkApp + (Lazy.force coq_cons, [|typ; dump_elt e; dump_list typ dump_elt l|]) - let rec pp_Rcst o cst = - match cst with - | Mc.C0 -> output_string o "C0" - | Mc.C1 -> output_string o "C1" - | Mc.CQ q -> output_string o "CQ _" - | Mc.CZ z -> pp_z o z - | Mc.CPlus (x, y) -> Printf.fprintf o "(%a + %a)" pp_Rcst x pp_Rcst y - | Mc.CMinus (x, y) -> Printf.fprintf o "(%a - %a)" pp_Rcst x pp_Rcst y - | Mc.CMult (x, y) -> Printf.fprintf o "(%a * %a)" pp_Rcst x pp_Rcst y - | Mc.CPow (x, y) -> Printf.fprintf o "(%a ^ _)" pp_Rcst x - | Mc.CInv t -> Printf.fprintf o "(/ %a)" pp_Rcst t - | Mc.COpp t -> Printf.fprintf o "(- %a)" pp_Rcst t - - let rec dump_Rcst cst = - match cst with - | Mc.C0 -> Lazy.force coq_C0 - | Mc.C1 -> Lazy.force coq_C1 - | Mc.CQ q -> EConstr.mkApp (Lazy.force coq_CQ, [|dump_q q|]) - | Mc.CZ z -> EConstr.mkApp (Lazy.force coq_CZ, [|dump_z z|]) - | Mc.CPlus (x, y) -> - EConstr.mkApp (Lazy.force coq_CPlus, [|dump_Rcst x; dump_Rcst y|]) - | Mc.CMinus (x, y) -> - EConstr.mkApp (Lazy.force coq_CMinus, [|dump_Rcst x; dump_Rcst y|]) - | Mc.CMult (x, y) -> - EConstr.mkApp (Lazy.force coq_CMult, [|dump_Rcst x; dump_Rcst y|]) - | Mc.CPow (x, y) -> - EConstr.mkApp - ( Lazy.force coq_CPow - , [| dump_Rcst x - ; ( match y with - | Mc.Inl z -> - EConstr.mkApp - ( Lazy.force coq_Inl - , [|Lazy.force coq_Z; Lazy.force coq_nat; dump_z z|] ) - | Mc.Inr n -> - EConstr.mkApp - ( Lazy.force coq_Inr - , [|Lazy.force coq_Z; Lazy.force coq_nat; dump_nat n|] ) ) |] - ) - | Mc.CInv t -> EConstr.mkApp (Lazy.force coq_CInv, [|dump_Rcst t|]) - | Mc.COpp t -> EConstr.mkApp (Lazy.force coq_COpp, [|dump_Rcst t|]) - - let rec dump_list typ dump_elt l = +let pp_list op cl elt o l = + let rec _pp o l = match l with - | [] -> EConstr.mkApp (Lazy.force coq_nil, [|typ|]) - | e :: l -> - EConstr.mkApp - (Lazy.force coq_cons, [|typ; dump_elt e; dump_list typ dump_elt l|]) - - let pp_list op cl elt o l = - let rec _pp o l = - match l with - | [] -> () - | [e] -> Printf.fprintf o "%a" elt e - | e :: l -> Printf.fprintf o "%a ,%a" elt e _pp l - in - Printf.fprintf o "%s%a%s" op _pp l cl + | [] -> () + | [e] -> Printf.fprintf o "%a" elt e + | e :: l -> Printf.fprintf o "%a ,%a" elt e _pp l + in + Printf.fprintf o "%s%a%s" op _pp l cl - let dump_var = dump_positive +let dump_var = dump_positive - let dump_expr typ dump_z e = - let rec dump_expr e = - match e with - | Mc.PEX n -> EConstr.mkApp (Lazy.force coq_PEX, [|typ; dump_var n|]) - | Mc.PEc z -> EConstr.mkApp (Lazy.force coq_PEc, [|typ; dump_z z|]) - | Mc.PEadd (e1, e2) -> - EConstr.mkApp (Lazy.force coq_PEadd, [|typ; dump_expr e1; dump_expr e2|]) - | Mc.PEsub (e1, e2) -> - EConstr.mkApp (Lazy.force coq_PEsub, [|typ; dump_expr e1; dump_expr e2|]) - | Mc.PEopp e -> EConstr.mkApp (Lazy.force coq_PEopp, [|typ; dump_expr e|]) - | Mc.PEmul (e1, e2) -> - EConstr.mkApp (Lazy.force coq_PEmul, [|typ; dump_expr e1; dump_expr e2|]) - | Mc.PEpow (e, n) -> - EConstr.mkApp (Lazy.force coq_PEpow, [|typ; dump_expr e; dump_n n|]) - in - dump_expr e +let dump_expr typ dump_z e = + let rec dump_expr e = + match e with + | Mc.PEX n -> EConstr.mkApp (Lazy.force coq_PEX, [|typ; dump_var n|]) + | Mc.PEc z -> EConstr.mkApp (Lazy.force coq_PEc, [|typ; dump_z z|]) + | Mc.PEadd (e1, e2) -> + EConstr.mkApp (Lazy.force coq_PEadd, [|typ; dump_expr e1; dump_expr e2|]) + | Mc.PEsub (e1, e2) -> + EConstr.mkApp (Lazy.force coq_PEsub, [|typ; dump_expr e1; dump_expr e2|]) + | Mc.PEopp e -> EConstr.mkApp (Lazy.force coq_PEopp, [|typ; dump_expr e|]) + | Mc.PEmul (e1, e2) -> + EConstr.mkApp (Lazy.force coq_PEmul, [|typ; dump_expr e1; dump_expr e2|]) + | Mc.PEpow (e, n) -> + EConstr.mkApp (Lazy.force coq_PEpow, [|typ; dump_expr e; dump_n n|]) + in + dump_expr e - let dump_pol typ dump_c e = - let rec dump_pol e = - match e with - | Mc.Pc n -> EConstr.mkApp (Lazy.force coq_Pc, [|typ; dump_c n|]) - | Mc.Pinj (p, pol) -> - EConstr.mkApp - (Lazy.force coq_Pinj, [|typ; dump_positive p; dump_pol pol|]) - | Mc.PX (pol1, p, pol2) -> - EConstr.mkApp - ( Lazy.force coq_PX - , [|typ; dump_pol pol1; dump_positive p; dump_pol pol2|] ) - in - dump_pol e - - let pp_pol pp_c o e = - let rec pp_pol o e = - match e with - | Mc.Pc n -> Printf.fprintf o "Pc %a" pp_c n - | Mc.Pinj (p, pol) -> - Printf.fprintf o "Pinj(%a,%a)" pp_positive p pp_pol pol - | Mc.PX (pol1, p, pol2) -> - Printf.fprintf o "PX(%a,%a,%a)" pp_pol pol1 pp_positive p pp_pol pol2 - in - pp_pol o e - - (* let pp_clause pp_c o (f: 'cst clause) = - List.iter (fun ((p,_),(t,_)) -> Printf.fprintf o "(%a @%a)" (pp_pol pp_c) p Tag.pp t) f *) - - let pp_clause_tag o (f : 'cst clause) = - List.iter (fun ((p, _), (t, _)) -> Printf.fprintf o "(_ @%a)" Tag.pp t) f - - (* let pp_cnf pp_c o (f:'cst cnf) = - List.iter (fun l -> Printf.fprintf o "[%a]" (pp_clause pp_c) l) f *) - - let pp_cnf_tag o (f : 'cst cnf) = - List.iter (fun l -> Printf.fprintf o "[%a]" pp_clause_tag l) f - - let dump_psatz typ dump_z e = - let z = Lazy.force typ in - let rec dump_cone e = - match e with - | Mc.PsatzIn n -> EConstr.mkApp (Lazy.force coq_PsatzIn, [|z; dump_nat n|]) - | Mc.PsatzMulC (e, c) -> - EConstr.mkApp - (Lazy.force coq_PsatzMultC, [|z; dump_pol z dump_z e; dump_cone c|]) - | Mc.PsatzSquare e -> - EConstr.mkApp (Lazy.force coq_PsatzSquare, [|z; dump_pol z dump_z e|]) - | Mc.PsatzAdd (e1, e2) -> - EConstr.mkApp - (Lazy.force coq_PsatzAdd, [|z; dump_cone e1; dump_cone e2|]) - | Mc.PsatzMulE (e1, e2) -> - EConstr.mkApp - (Lazy.force coq_PsatzMulE, [|z; dump_cone e1; dump_cone e2|]) - | Mc.PsatzC p -> EConstr.mkApp (Lazy.force coq_PsatzC, [|z; dump_z p|]) - | Mc.PsatzZ -> EConstr.mkApp (Lazy.force coq_PsatzZ, [|z|]) - in - dump_cone e - - let pp_psatz pp_z o e = - let rec pp_cone o e = - match e with - | Mc.PsatzIn n -> Printf.fprintf o "(In %a)%%nat" pp_nat n - | Mc.PsatzMulC (e, c) -> - Printf.fprintf o "( %a [*] %a)" (pp_pol pp_z) e pp_cone c - | Mc.PsatzSquare e -> Printf.fprintf o "(%a^2)" (pp_pol pp_z) e - | Mc.PsatzAdd (e1, e2) -> - Printf.fprintf o "(%a [+] %a)" pp_cone e1 pp_cone e2 - | Mc.PsatzMulE (e1, e2) -> - Printf.fprintf o "(%a [*] %a)" pp_cone e1 pp_cone e2 - | Mc.PsatzC p -> Printf.fprintf o "(%a)%%positive" pp_z p - | Mc.PsatzZ -> Printf.fprintf o "0" - in - pp_cone o e +let dump_pol typ dump_c e = + let rec dump_pol e = + match e with + | Mc.Pc n -> EConstr.mkApp (Lazy.force coq_Pc, [|typ; dump_c n|]) + | Mc.Pinj (p, pol) -> + EConstr.mkApp (Lazy.force coq_Pinj, [|typ; dump_positive p; dump_pol pol|]) + | Mc.PX (pol1, p, pol2) -> + EConstr.mkApp + ( Lazy.force coq_PX + , [|typ; dump_pol pol1; dump_positive p; dump_pol pol2|] ) + in + dump_pol e - let dump_op = function - | Mc.OpEq -> Lazy.force coq_OpEq - | Mc.OpNEq -> Lazy.force coq_OpNEq - | Mc.OpLe -> Lazy.force coq_OpLe - | Mc.OpGe -> Lazy.force coq_OpGe - | Mc.OpGt -> Lazy.force coq_OpGt - | Mc.OpLt -> Lazy.force coq_OpLt +let pp_pol pp_c o e = + let rec pp_pol o e = + match e with + | Mc.Pc n -> Printf.fprintf o "Pc %a" pp_c n + | Mc.Pinj (p, pol) -> + Printf.fprintf o "Pinj(%a,%a)" pp_positive p pp_pol pol + | Mc.PX (pol1, p, pol2) -> + Printf.fprintf o "PX(%a,%a,%a)" pp_pol pol1 pp_positive p pp_pol pol2 + in + pp_pol o e - let dump_cstr typ dump_constant {Mc.flhs = e1; Mc.fop = o; Mc.frhs = e2} = - EConstr.mkApp - ( Lazy.force coq_Build - , [| typ - ; dump_expr typ dump_constant e1 - ; dump_op o - ; dump_expr typ dump_constant e2 |] ) +(* let pp_clause pp_c o (f: 'cst clause) = + List.iter (fun ((p,_),(t,_)) -> Printf.fprintf o "(%a @%a)" (pp_pol pp_c) p Tag.pp t) f *) - let assoc_const sigma x l = - try - snd - (List.find (fun (x', y) -> EConstr.eq_constr sigma x (Lazy.force x')) l) - with Not_found -> raise ParseError - - let zop_table_prop = - [ (coq_Zgt, Mc.OpGt) - ; (coq_Zge, Mc.OpGe) - ; (coq_Zlt, Mc.OpLt) - ; (coq_Zle, Mc.OpLe) ] - - let zop_table_bool = - [ (coq_Zgtb, Mc.OpGt) - ; (coq_Zgeb, Mc.OpGe) - ; (coq_Zltb, Mc.OpLt) - ; (coq_Zleb, Mc.OpLe) - ; (coq_Zeqb, Mc.OpEq) ] - - let rop_table_prop = - [ (coq_Rgt, Mc.OpGt) - ; (coq_Rge, Mc.OpGe) - ; (coq_Rlt, Mc.OpLt) - ; (coq_Rle, Mc.OpLe) ] - - let rop_table_bool = [] - - let qop_table_prop = - [(coq_Qlt, Mc.OpLt); (coq_Qle, Mc.OpLe); (coq_Qeq, Mc.OpEq)] - - let qop_table_bool = [] - - type gl = {env : Environ.env; sigma : Evd.evar_map} - - let is_convertible gl t1 t2 = Reductionops.is_conv gl.env gl.sigma t1 t2 - - let parse_operator table_prop table_bool has_equality typ gl k (op, args) = - let sigma = gl.sigma in - match args with - | [|a1; a2|] -> - ( assoc_const sigma op - (match k with Mc.IsProp -> table_prop | Mc.IsBool -> table_bool) - , a1 - , a2 ) - | [|ty; a1; a2|] -> - if - has_equality - && EConstr.eq_constr sigma op (Lazy.force coq_eq) - && is_convertible gl ty (Lazy.force typ) - then (Mc.OpEq, args.(1), args.(2)) - else raise ParseError - | _ -> raise ParseError +let pp_clause_tag o (f : 'cst clause) = + List.iter (fun ((p, _), (t, _)) -> Printf.fprintf o "(_ @%a)" Tag.pp t) f - let parse_zop = parse_operator zop_table_prop zop_table_bool true coq_Z - let parse_rop = parse_operator rop_table_prop [] true coq_R - let parse_qop = parse_operator qop_table_prop [] false coq_R +(* let pp_cnf pp_c o (f:'cst cnf) = + List.iter (fun l -> Printf.fprintf o "[%a]" (pp_clause pp_c) l) f *) - type 'a op = - | Binop of ('a Mc.pExpr -> 'a Mc.pExpr -> 'a Mc.pExpr) - | Opp - | Power - | Ukn of string +let pp_cnf_tag o (f : 'cst cnf) = + List.iter (fun l -> Printf.fprintf o "[%a]" pp_clause_tag l) f - let assoc_ops sigma x l = - try - snd - (List.find (fun (x', y) -> EConstr.eq_constr sigma x (Lazy.force x')) l) - with Not_found -> Ukn "Oups" +let dump_psatz typ dump_z e = + let z = Lazy.force typ in + let rec dump_cone e = + match e with + | Mc.PsatzIn n -> EConstr.mkApp (Lazy.force coq_PsatzIn, [|z; dump_nat n|]) + | Mc.PsatzMulC (e, c) -> + EConstr.mkApp + (Lazy.force coq_PsatzMultC, [|z; dump_pol z dump_z e; dump_cone c|]) + | Mc.PsatzSquare e -> + EConstr.mkApp (Lazy.force coq_PsatzSquare, [|z; dump_pol z dump_z e|]) + | Mc.PsatzAdd (e1, e2) -> + EConstr.mkApp (Lazy.force coq_PsatzAdd, [|z; dump_cone e1; dump_cone e2|]) + | Mc.PsatzMulE (e1, e2) -> + EConstr.mkApp (Lazy.force coq_PsatzMulE, [|z; dump_cone e1; dump_cone e2|]) + | Mc.PsatzC p -> EConstr.mkApp (Lazy.force coq_PsatzC, [|z; dump_z p|]) + | Mc.PsatzZ -> EConstr.mkApp (Lazy.force coq_PsatzZ, [|z|]) + in + dump_cone e - (** +let pp_psatz pp_z o e = + let rec pp_cone o e = + match e with + | Mc.PsatzIn n -> Printf.fprintf o "(In %a)%%nat" pp_nat n + | Mc.PsatzMulC (e, c) -> + Printf.fprintf o "( %a [*] %a)" (pp_pol pp_z) e pp_cone c + | Mc.PsatzSquare e -> Printf.fprintf o "(%a^2)" (pp_pol pp_z) e + | Mc.PsatzAdd (e1, e2) -> + Printf.fprintf o "(%a [+] %a)" pp_cone e1 pp_cone e2 + | Mc.PsatzMulE (e1, e2) -> + Printf.fprintf o "(%a [*] %a)" pp_cone e1 pp_cone e2 + | Mc.PsatzC p -> Printf.fprintf o "(%a)%%positive" pp_z p + | Mc.PsatzZ -> Printf.fprintf o "0" + in + pp_cone o e + +let dump_op = function + | Mc.OpEq -> Lazy.force coq_OpEq + | Mc.OpNEq -> Lazy.force coq_OpNEq + | Mc.OpLe -> Lazy.force coq_OpLe + | Mc.OpGe -> Lazy.force coq_OpGe + | Mc.OpGt -> Lazy.force coq_OpGt + | Mc.OpLt -> Lazy.force coq_OpLt + +let dump_cstr typ dump_constant {Mc.flhs = e1; Mc.fop = o; Mc.frhs = e2} = + EConstr.mkApp + ( Lazy.force coq_Build + , [| typ + ; dump_expr typ dump_constant e1 + ; dump_op o + ; dump_expr typ dump_constant e2 |] ) + +let assoc_const sigma x l = + try + snd (List.find (fun (x', y) -> EConstr.eq_constr sigma x (Lazy.force x')) l) + with Not_found -> raise ParseError + +let zop_table_prop = + [ (coq_Zgt, Mc.OpGt) + ; (coq_Zge, Mc.OpGe) + ; (coq_Zlt, Mc.OpLt) + ; (coq_Zle, Mc.OpLe) ] + +let zop_table_bool = + [ (coq_Zgtb, Mc.OpGt) + ; (coq_Zgeb, Mc.OpGe) + ; (coq_Zltb, Mc.OpLt) + ; (coq_Zleb, Mc.OpLe) + ; (coq_Zeqb, Mc.OpEq) ] + +let rop_table_prop = + [ (coq_Rgt, Mc.OpGt) + ; (coq_Rge, Mc.OpGe) + ; (coq_Rlt, Mc.OpLt) + ; (coq_Rle, Mc.OpLe) ] + +let rop_table_bool = [] +let qop_table_prop = [(coq_Qlt, Mc.OpLt); (coq_Qle, Mc.OpLe); (coq_Qeq, Mc.OpEq)] +let qop_table_bool = [] + +type gl = Environ.env * Evd.evar_map + +let is_convertible env sigma t1 t2 = Reductionops.is_conv env sigma t1 t2 + +let parse_operator table_prop table_bool has_equality typ (env, sigma) k + (op, args) = + match args with + | [|a1; a2|] -> + ( assoc_const sigma op + (match k with Mc.IsProp -> table_prop | Mc.IsBool -> table_bool) + , a1 + , a2 ) + | [|ty; a1; a2|] -> + if + has_equality + && EConstr.eq_constr sigma op (Lazy.force coq_eq) + && is_convertible env sigma ty (Lazy.force typ) + then (Mc.OpEq, args.(1), args.(2)) + else raise ParseError + | _ -> raise ParseError + +let parse_zop = parse_operator zop_table_prop zop_table_bool true coq_Z +let parse_rop = parse_operator rop_table_prop [] true coq_R +let parse_qop = parse_operator qop_table_prop [] false coq_R + +type 'a op = + | Binop of ('a Mc.pExpr -> 'a Mc.pExpr -> 'a Mc.pExpr) + | Opp + | Power + | Ukn of string + +let assoc_ops sigma x l = + try + snd (List.find (fun (x', y) -> EConstr.eq_constr sigma x (Lazy.force x')) l) + with Not_found -> Ukn "Oups" + +(** * MODULE: Env is for environment. *) - module Env = struct - type t = - { vars : (EConstr.t * Mc.kind) list - ; (* The list represents a mapping from EConstr.t to indexes. *) - gl : gl - (* The evar_map may be updated due to unification of universes *) } - - let empty gl = {vars = []; gl} - - (** [eq_constr gl x y] returns an updated [gl] if x and y can be unified *) - let eq_constr gl x y = - let evd = gl.sigma in - match EConstr.eq_constr_universes_proj gl.env evd x y with - | Some csts -> ( - let csts = - UnivProblem.to_constraints ~force_weak:false (Evd.universes evd) csts - in - match Evd.add_constraints evd csts with - | evd -> Some {gl with sigma = evd} - | exception Univ.UniverseInconsistency _ -> None ) - | None -> None - - let compute_rank_add env v is_prop = - let rec _add gl vars n v = - match vars with - | [] -> (gl, [(v, is_prop)], n) - | (e, b) :: l -> ( - match eq_constr gl e v with - | Some gl' -> (gl', vars, n) - | None -> - let gl, l', n = _add gl l (n + 1) v in - (gl, (e, b) :: l', n) ) - in - let gl', vars', n = _add env.gl env.vars 1 v in - ({vars = vars'; gl = gl'}, CamlToCoq.positive n) - - let get_rank env v = - let gl = env.gl in - let rec _get_rank env n = - match env with - | [] -> raise (Invalid_argument "get_rank") - | (e, _) :: l -> ( - match eq_constr gl e v with Some _ -> n | None -> _get_rank l (n + 1) - ) - in - _get_rank env.vars 1 - - let elements env = env.vars - - (* let string_of_env gl env = - let rec string_of_env i env acc = - match env with - | [] -> acc - | e::env -> string_of_env (i+1) env - (IMap.add i - (Pp.string_of_ppcmds - (Printer.pr_econstr_env gl.env gl.sigma e)) acc) in - string_of_env 1 env IMap.empty - *) - let pp gl env = - let ppl = - List.mapi - (fun i (e, _) -> - Pp.str "x" - ++ Pp.int (i + 1) - ++ Pp.str ":" - ++ Printer.pr_econstr_env gl.env gl.sigma e) - env +module Env = struct + type t = + { vars : (EConstr.t * Mc.kind) list + ; (* The list represents a mapping from EConstr.t to indexes. *) + gl : gl (* The evar_map may be updated due to unification of universes *) + } + + let empty gl = {vars = []; gl} + + (** [eq_constr gl x y] returns an updated [gl] if x and y can be unified *) + let eq_constr (env, sigma) x y = + match EConstr.eq_constr_universes_proj env sigma x y with + | Some csts -> ( + let csts = + UnivProblem.to_constraints ~force_weak:false (Evd.universes sigma) csts in - List.fold_right (fun e p -> e ++ Pp.str " ; " ++ p) ppl (Pp.str "\n") - end + match Evd.add_constraints sigma csts with + | sigma -> Some (env, sigma) + | exception Univ.UniverseInconsistency _ -> None ) + | None -> None + + let compute_rank_add env v is_prop = + let rec _add gl vars n v = + match vars with + | [] -> (gl, [(v, is_prop)], n) + | (e, b) :: l -> ( + match eq_constr gl e v with + | Some gl' -> (gl', vars, n) + | None -> + let gl, l', n = _add gl l (n + 1) v in + (gl, (e, b) :: l', n) ) + in + let gl', vars', n = _add env.gl env.vars 1 v in + ({vars = vars'; gl = gl'}, CamlToCoq.positive n) + + let get_rank env v = + let gl = env.gl in + let rec _get_rank env n = + match env with + | [] -> raise (Invalid_argument "get_rank") + | (e, _) :: l -> ( + match eq_constr gl e v with Some _ -> n | None -> _get_rank l (n + 1) ) + in + _get_rank env.vars 1 + + let elements env = env.vars + + (* let string_of_env gl env = + let rec string_of_env i env acc = + match env with + | [] -> acc + | e::env -> string_of_env (i+1) env + (IMap.add i + (Pp.string_of_ppcmds + (Printer.pr_econstr_env gl.env gl.sigma e)) acc) in + string_of_env 1 env IMap.empty + *) + let pp (genv, sigma) env = + let ppl = + List.mapi + (fun i (e, _) -> + Pp.str "x" + ++ Pp.int (i + 1) + ++ Pp.str ":" + ++ Printer.pr_econstr_env genv sigma e) + env + in + List.fold_right (fun e p -> e ++ Pp.str " ; " ++ p) ppl (Pp.str "\n") +end - (* MODULE END: Env *) +(* MODULE END: Env *) - (** +(** * This is the big generic function for expression parsers. *) - let parse_expr gl parse_constant parse_exp ops_spec env term = - if debug then - Feedback.msg_debug - (Pp.str "parse_expr: " ++ Printer.pr_leconstr_env gl.env gl.sigma term); - let parse_variable env term = - let env, n = Env.compute_rank_add env term Mc.IsBool in - (Mc.PEX n, env) +let parse_expr (genv, sigma) parse_constant parse_exp ops_spec env term = + if debug then + Feedback.msg_debug + (Pp.str "parse_expr: " ++ Printer.pr_leconstr_env genv sigma term); + let parse_variable env term = + let env, n = Env.compute_rank_add env term Mc.IsBool in + (Mc.PEX n, env) + in + let rec parse_expr env term = + let combine env op (t1, t2) = + let expr1, env = parse_expr env t1 in + let expr2, env = parse_expr env t2 in + (op expr1 expr2, env) in - let rec parse_expr env term = - let combine env op (t1, t2) = - let expr1, env = parse_expr env t1 in - let expr2, env = parse_expr env t2 in - (op expr1 expr2, env) - in - try (Mc.PEc (parse_constant gl term), env) - with ParseError -> ( - match EConstr.kind gl.sigma term with - | App (t, args) -> ( - match EConstr.kind gl.sigma t with - | Const c -> ( - match assoc_ops gl.sigma t ops_spec with - | Binop f -> combine env f (args.(0), args.(1)) - | Opp -> + try (Mc.PEc (parse_constant (genv, sigma) term), env) + with ParseError -> ( + match EConstr.kind sigma term with + | App (t, args) -> ( + match EConstr.kind sigma t with + | Const c -> ( + match assoc_ops sigma t ops_spec with + | Binop f -> combine env f (args.(0), args.(1)) + | Opp -> + let expr, env = parse_expr env args.(0) in + (Mc.PEopp expr, env) + | Power -> ( + try let expr, env = parse_expr env args.(0) in - (Mc.PEopp expr, env) - | Power -> ( - try - let expr, env = parse_expr env args.(0) in - let power = parse_exp expr args.(1) in - (power, env) - with ParseError -> - (* if the exponent is a variable *) - let env, n = Env.compute_rank_add env term Mc.IsBool in - (Mc.PEX n, env) ) - | Ukn s -> - if debug then ( - Printf.printf "unknown op: %s\n" s; - flush stdout ); + let power = parse_exp expr args.(1) in + (power, env) + with ParseError -> + (* if the exponent is a variable *) let env, n = Env.compute_rank_add env term Mc.IsBool in (Mc.PEX n, env) ) - | _ -> parse_variable env term ) + | Ukn s -> + if debug then ( + Printf.printf "unknown op: %s\n" s; + flush stdout ); + let env, n = Env.compute_rank_add env term Mc.IsBool in + (Mc.PEX n, env) ) | _ -> parse_variable env term ) - in - parse_expr env term - - let zop_spec = - [ (coq_Zplus, Binop (fun x y -> Mc.PEadd (x, y))) - ; (coq_Zminus, Binop (fun x y -> Mc.PEsub (x, y))) - ; (coq_Zmult, Binop (fun x y -> Mc.PEmul (x, y))) - ; (coq_Zopp, Opp) - ; (coq_Zpower, Power) ] - - let qop_spec = - [ (coq_Qplus, Binop (fun x y -> Mc.PEadd (x, y))) - ; (coq_Qminus, Binop (fun x y -> Mc.PEsub (x, y))) - ; (coq_Qmult, Binop (fun x y -> Mc.PEmul (x, y))) - ; (coq_Qopp, Opp) - ; (coq_Qpower, Power) ] - - let rop_spec = - [ (coq_Rplus, Binop (fun x y -> Mc.PEadd (x, y))) - ; (coq_Rminus, Binop (fun x y -> Mc.PEsub (x, y))) - ; (coq_Rmult, Binop (fun x y -> Mc.PEmul (x, y))) - ; (coq_Ropp, Opp) - ; (coq_Rpower, Power) ] - - let parse_constant parse gl t = parse gl.sigma t - - (** [parse_more_constant parse gl t] returns the reification of term [t]. + | _ -> parse_variable env term ) + in + parse_expr env term + +let zop_spec = + [ (coq_Zplus, Binop (fun x y -> Mc.PEadd (x, y))) + ; (coq_Zminus, Binop (fun x y -> Mc.PEsub (x, y))) + ; (coq_Zmult, Binop (fun x y -> Mc.PEmul (x, y))) + ; (coq_Zopp, Opp) + ; (coq_Zpower, Power) ] + +let qop_spec = + [ (coq_Qplus, Binop (fun x y -> Mc.PEadd (x, y))) + ; (coq_Qminus, Binop (fun x y -> Mc.PEsub (x, y))) + ; (coq_Qmult, Binop (fun x y -> Mc.PEmul (x, y))) + ; (coq_Qopp, Opp) + ; (coq_Qpower, Power) ] + +let rop_spec = + [ (coq_Rplus, Binop (fun x y -> Mc.PEadd (x, y))) + ; (coq_Rminus, Binop (fun x y -> Mc.PEsub (x, y))) + ; (coq_Rmult, Binop (fun x y -> Mc.PEmul (x, y))) + ; (coq_Ropp, Opp) + ; (coq_Rpower, Power) ] + +let parse_constant parse ((genv : Environ.env), sigma) t = parse sigma t + +(** [parse_more_constant parse gl t] returns the reification of term [t]. If [t] is a ground term, then it is first reduced to normal form before using a 'syntactic' parser *) - let parse_more_constant parse gl t = - try parse gl t - with ParseError -> - if debug then Feedback.msg_debug Pp.(str "try harder"); - if is_ground_term gl.env gl.sigma t then - parse gl (Redexpr.cbv_vm gl.env gl.sigma t) - else raise ParseError - - let zconstant = parse_constant parse_z - let qconstant = parse_constant parse_q - let nconstant = parse_constant parse_nat - - (** [parse_more_zexpr parse_constant gl] improves the parsing of exponent +let parse_more_constant parse (genv, sigma) t = + try parse (genv, sigma) t + with ParseError -> + if debug then Feedback.msg_debug Pp.(str "try harder"); + if is_ground_term genv sigma t then + parse (genv, sigma) (Redexpr.cbv_vm genv sigma t) + else raise ParseError + +let zconstant = parse_constant parse_z +let qconstant = parse_constant parse_q +let nconstant = parse_constant parse_nat + +(** [parse_more_zexpr parse_constant gl] improves the parsing of exponent which can be arithmetic expressions (without variables). [parse_constant_expr] returns a constant if the argument is an expression without variables. *) - let rec parse_zexpr gl = - parse_expr gl zconstant - (fun expr (x : EConstr.t) -> - let z = parse_zconstant gl x in - match z with - | Mc.Zneg _ -> Mc.PEc Mc.Z0 - | _ -> Mc.PEpow (expr, Mc.Z.to_N z)) - zop_spec - - and parse_zconstant gl e = - let e, _ = parse_zexpr gl (Env.empty gl) e in - match Mc.zeval_const e with None -> raise ParseError | Some z -> z - - (* NB: R is a different story. - Because it is axiomatised, reducing would not be effective. - Therefore, there is a specific parser for constant over R - *) +let rec parse_zexpr gl = + parse_expr gl zconstant + (fun expr (x : EConstr.t) -> + let z = parse_zconstant gl x in + match z with + | Mc.Zneg _ -> Mc.PEc Mc.Z0 + | _ -> Mc.PEpow (expr, Mc.Z.to_N z)) + zop_spec + +and parse_zconstant gl e = + let e, _ = parse_zexpr gl (Env.empty gl) e in + match Mc.zeval_const e with None -> raise ParseError | Some z -> z + +(* NB: R is a different story. + Because it is axiomatised, reducing would not be effective. + Therefore, there is a specific parser for constant over R +*) - let rconst_assoc = - [ (coq_Rplus, fun x y -> Mc.CPlus (x, y)) - ; (coq_Rminus, fun x y -> Mc.CMinus (x, y)) - ; (coq_Rmult, fun x y -> Mc.CMult (x, y)) - (* coq_Rdiv , (fun x y -> Mc.CMult(x,Mc.CInv y)) ;*) ] +let rconst_assoc = + [ (coq_Rplus, fun x y -> Mc.CPlus (x, y)) + ; (coq_Rminus, fun x y -> Mc.CMinus (x, y)) + ; (coq_Rmult, fun x y -> Mc.CMult (x, y)) + (* coq_Rdiv , (fun x y -> Mc.CMult(x,Mc.CInv y)) ;*) ] - let rconstant gl term = - let sigma = gl.sigma in - let rec rconstant term = - match EConstr.kind sigma term with - | Const x -> - if EConstr.eq_constr sigma term (Lazy.force coq_R0) then Mc.C0 - else if EConstr.eq_constr sigma term (Lazy.force coq_R1) then Mc.C1 - else raise ParseError - | App (op, args) -> ( - try - (* the evaluation order is important in the following *) - let f = assoc_const sigma op rconst_assoc in - let a = rconstant args.(0) in - let b = rconstant args.(1) in - f a b - with ParseError -> ( - match op with - | op when EConstr.eq_constr sigma op (Lazy.force coq_Rinv) -> - let arg = rconstant args.(0) in - if Mc.qeq_bool (Mc.q_of_Rcst arg) {Mc.qnum = Mc.Z0; Mc.qden = Mc.XH} - then raise ParseError - (* This is a division by zero -- no semantics *) - else Mc.CInv arg - | op when EConstr.eq_constr sigma op (Lazy.force coq_Rpower) -> - Mc.CPow - ( rconstant args.(0) - , Mc.Inr (parse_more_constant nconstant gl args.(1)) ) - | op when EConstr.eq_constr sigma op (Lazy.force coq_IQR) -> - Mc.CQ (qconstant gl args.(0)) - | op when EConstr.eq_constr sigma op (Lazy.force coq_IZR) -> - Mc.CZ (parse_more_constant zconstant gl args.(0)) - | _ -> raise ParseError ) ) - | _ -> raise ParseError - in - rconstant term - - let rconstant gl term = - if debug then - Feedback.msg_debug - ( Pp.str "rconstant: " - ++ Printer.pr_leconstr_env gl.env gl.sigma term - ++ fnl () ); - let res = rconstant gl term in - if debug then ( - Printf.printf "rconstant -> %a\n" pp_Rcst res; - flush stdout ); - res +let rconstant (genv, sigma) term = + let rec rconstant term = + match EConstr.kind sigma term with + | Const x -> + if EConstr.eq_constr sigma term (Lazy.force coq_R0) then Mc.C0 + else if EConstr.eq_constr sigma term (Lazy.force coq_R1) then Mc.C1 + else raise ParseError + | App (op, args) -> ( + try + (* the evaluation order is important in the following *) + let f = assoc_const sigma op rconst_assoc in + let a = rconstant args.(0) in + let b = rconstant args.(1) in + f a b + with ParseError -> ( + match op with + | op when EConstr.eq_constr sigma op (Lazy.force coq_Rinv) -> + let arg = rconstant args.(0) in + if Mc.qeq_bool (Mc.q_of_Rcst arg) {Mc.qnum = Mc.Z0; Mc.qden = Mc.XH} + then raise ParseError (* This is a division by zero -- no semantics *) + else Mc.CInv arg + | op when EConstr.eq_constr sigma op (Lazy.force coq_Rpower) -> + Mc.CPow + ( rconstant args.(0) + , Mc.Inr (parse_more_constant nconstant (genv, sigma) args.(1)) ) + | op when EConstr.eq_constr sigma op (Lazy.force coq_IQR) -> + Mc.CQ (qconstant (genv, sigma) args.(0)) + | op when EConstr.eq_constr sigma op (Lazy.force coq_IZR) -> + Mc.CZ (parse_more_constant zconstant (genv, sigma) args.(0)) + | _ -> raise ParseError ) ) + | _ -> raise ParseError + in + rconstant term + +let rconstant (genv, sigma) term = + if debug then + Feedback.msg_debug + (Pp.str "rconstant: " ++ Printer.pr_leconstr_env genv sigma term ++ fnl ()); + let res = rconstant (genv, sigma) term in + if debug then ( + Printf.printf "rconstant -> %a\n" pp_Rcst res; + flush stdout ); + res - let parse_qexpr gl = - parse_expr gl qconstant - (fun expr x -> - let exp = zconstant gl x in - match exp with - | Mc.Zneg _ -> ( - match expr with - | Mc.PEc q -> Mc.PEc (Mc.qpower q exp) - | _ -> raise ParseError ) - | _ -> - let exp = Mc.Z.to_N exp in - Mc.PEpow (expr, exp)) - qop_spec - - let parse_rexpr gl = - parse_expr gl rconstant - (fun expr x -> - let exp = Mc.N.of_nat (parse_nat gl.sigma x) in +let parse_qexpr gl = + parse_expr gl qconstant + (fun expr x -> + let exp = zconstant gl x in + match exp with + | Mc.Zneg _ -> ( + match expr with + | Mc.PEc q -> Mc.PEc (Mc.qpower q exp) + | _ -> raise ParseError ) + | _ -> + let exp = Mc.Z.to_N exp in Mc.PEpow (expr, exp)) - rop_spec - - let parse_arith parse_op parse_expr (k : Mc.kind) env cstr gl = - let sigma = gl.sigma in - if debug then - Feedback.msg_debug - ( Pp.str "parse_arith: " - ++ Printer.pr_leconstr_env gl.env sigma cstr - ++ fnl () ); - match EConstr.kind sigma cstr with - | App (op, args) -> - let op, lhs, rhs = parse_op gl k (op, args) in - let e1, env = parse_expr gl env lhs in - let e2, env = parse_expr gl env rhs in - ({Mc.flhs = e1; Mc.fop = op; Mc.frhs = e2}, env) - | _ -> failwith "error : parse_arith(2)" - - let parse_zarith = parse_arith parse_zop parse_zexpr - let parse_qarith = parse_arith parse_qop parse_qexpr - let parse_rarith = parse_arith parse_rop parse_rexpr - - (* generic parsing of arithmetic expressions *) - - let mkAND b f1 f2 = Mc.AND (b, f1, f2) - let mkOR b f1 f2 = Mc.OR (b, f1, f2) - let mkIff b f1 f2 = Mc.IFF (b, f1, f2) - let mkIMPL b f1 f2 = Mc.IMPL (b, f1, None, f2) - let mkEQ f1 f2 = Mc.EQ (f1, f2) - - let mkformula_binary b g term f1 f2 = - match (f1, f2) with - | Mc.X (b1, _), Mc.X (b2, _) -> Mc.X (b, term) - | _ -> g f1 f2 + qop_spec + +let parse_rexpr (genv, sigma) = + parse_expr (genv, sigma) rconstant + (fun expr x -> + let exp = Mc.N.of_nat (parse_nat sigma x) in + Mc.PEpow (expr, exp)) + rop_spec + +let parse_arith parse_op parse_expr (k : Mc.kind) env cstr (genv, sigma) = + if debug then + Feedback.msg_debug + ( Pp.str "parse_arith: " + ++ Printer.pr_leconstr_env genv sigma cstr + ++ fnl () ); + match EConstr.kind sigma cstr with + | App (op, args) -> + let op, lhs, rhs = parse_op (genv, sigma) k (op, args) in + let e1, env = parse_expr (genv, sigma) env lhs in + let e2, env = parse_expr (genv, sigma) env rhs in + ({Mc.flhs = e1; Mc.fop = op; Mc.frhs = e2}, env) + | _ -> failwith "error : parse_arith(2)" + +let parse_zarith = parse_arith parse_zop parse_zexpr +let parse_qarith = parse_arith parse_qop parse_qexpr +let parse_rarith = parse_arith parse_rop parse_rexpr + +(* generic parsing of arithmetic expressions *) + +let mkAND b f1 f2 = Mc.AND (b, f1, f2) +let mkOR b f1 f2 = Mc.OR (b, f1, f2) +let mkIff b f1 f2 = Mc.IFF (b, f1, f2) +let mkIMPL b f1 f2 = Mc.IMPL (b, f1, None, f2) +let mkEQ f1 f2 = Mc.EQ (f1, f2) + +let mkformula_binary b g term f1 f2 = + match (f1, f2) with + | Mc.X (b1, _), Mc.X (b2, _) -> Mc.X (b, term) + | _ -> g f1 f2 - (** +(** * This is the big generic function for formula parsers. *) - let is_prop env sigma term = - let sort = Retyping.get_sort_of env sigma term in - Sorts.is_prop sort +let is_prop env sigma term = + let sort = Retyping.get_sort_of env sigma term in + Sorts.is_prop sort - type formula_op = - { op_and : EConstr.t - ; op_or : EConstr.t - ; op_iff : EConstr.t - ; op_not : EConstr.t - ; op_tt : EConstr.t - ; op_ff : EConstr.t } +type formula_op = + { op_and : EConstr.t + ; op_or : EConstr.t + ; op_iff : EConstr.t + ; op_not : EConstr.t + ; op_tt : EConstr.t + ; op_ff : EConstr.t } - let prop_op = - lazy - { op_and = Lazy.force coq_and - ; op_or = Lazy.force coq_or - ; op_iff = Lazy.force coq_iff - ; op_not = Lazy.force coq_not - ; op_tt = Lazy.force coq_True - ; op_ff = Lazy.force coq_False } - - let bool_op = - lazy - { op_and = Lazy.force coq_andb - ; op_or = Lazy.force coq_orb - ; op_iff = Lazy.force coq_eqb - ; op_not = Lazy.force coq_negb - ; op_tt = Lazy.force coq_true - ; op_ff = Lazy.force coq_false } - - let parse_formula gl parse_atom env tg term = - let sigma = gl.sigma in - let parse_atom b env tg t = - try - let at, env = parse_atom b env t gl in - (Mc.A (b, at, (tg, t)), env, Tag.next tg) - with ParseError -> (Mc.X (b, t), env, tg) - in - let prop_op = Lazy.force prop_op in - let bool_op = Lazy.force bool_op in - let eq = Lazy.force coq_eq in - let bool = Lazy.force coq_bool in - let rec xparse_formula op k env tg term = - match EConstr.kind sigma term with - | App (l, rst) -> ( - match rst with - | [|a; b|] when EConstr.eq_constr sigma l op.op_and -> - let f, env, tg = xparse_formula op k env tg a in - let g, env, tg = xparse_formula op k env tg b in - (mkformula_binary k (mkAND k) term f g, env, tg) - | [|a; b|] when EConstr.eq_constr sigma l op.op_or -> - let f, env, tg = xparse_formula op k env tg a in - let g, env, tg = xparse_formula op k env tg b in - (mkformula_binary k (mkOR k) term f g, env, tg) - | [|a; b|] when EConstr.eq_constr sigma l op.op_iff -> - let f, env, tg = xparse_formula op k env tg a in - let g, env, tg = xparse_formula op k env tg b in - (mkformula_binary k (mkIff k) term f g, env, tg) - | [|ty; a; b|] - when EConstr.eq_constr sigma l eq && is_convertible gl ty bool -> - let f, env, tg = xparse_formula bool_op Mc.IsBool env tg a in - let g, env, tg = xparse_formula bool_op Mc.IsBool env tg b in - (mkformula_binary Mc.IsProp mkEQ term f g, env, tg) - | [|a|] when EConstr.eq_constr sigma l op.op_not -> - let f, env, tg = xparse_formula op k env tg a in - (Mc.NOT (k, f), env, tg) - | _ -> parse_atom k env tg term ) - | Prod (typ, a, b) - when kind_is_prop k - && (typ.binder_name = Anonymous || EConstr.Vars.noccurn sigma 1 b) - -> +let prop_op = + lazy + { op_and = Lazy.force coq_and + ; op_or = Lazy.force coq_or + ; op_iff = Lazy.force coq_iff + ; op_not = Lazy.force coq_not + ; op_tt = Lazy.force coq_True + ; op_ff = Lazy.force coq_False } + +let bool_op = + lazy + { op_and = Lazy.force coq_andb + ; op_or = Lazy.force coq_orb + ; op_iff = Lazy.force coq_eqb + ; op_not = Lazy.force coq_negb + ; op_tt = Lazy.force coq_true + ; op_ff = Lazy.force coq_false } + +let parse_formula (genv, sigma) parse_atom env tg term = + let parse_atom b env tg t = + try + let at, env = parse_atom b env t (genv, sigma) in + (Mc.A (b, at, (tg, t)), env, Tag.next tg) + with ParseError -> (Mc.X (b, t), env, tg) + in + let prop_op = Lazy.force prop_op in + let bool_op = Lazy.force bool_op in + let eq = Lazy.force coq_eq in + let bool = Lazy.force coq_bool in + let rec xparse_formula op k env tg term = + match EConstr.kind sigma term with + | App (l, rst) -> ( + match rst with + | [|a; b|] when EConstr.eq_constr sigma l op.op_and -> let f, env, tg = xparse_formula op k env tg a in let g, env, tg = xparse_formula op k env tg b in - (mkformula_binary Mc.IsProp (mkIMPL Mc.IsProp) term f g, env, tg) - | _ -> - if EConstr.eq_constr sigma term op.op_tt then (Mc.TT k, env, tg) - else if EConstr.eq_constr sigma term op.op_ff then Mc.(FF k, env, tg) - else (Mc.X (k, term), env, tg) - in - xparse_formula prop_op Mc.IsProp env tg (*Reductionops.whd_zeta*) term + (mkformula_binary k (mkAND k) term f g, env, tg) + | [|a; b|] when EConstr.eq_constr sigma l op.op_or -> + let f, env, tg = xparse_formula op k env tg a in + let g, env, tg = xparse_formula op k env tg b in + (mkformula_binary k (mkOR k) term f g, env, tg) + | [|a; b|] when EConstr.eq_constr sigma l op.op_iff -> + let f, env, tg = xparse_formula op k env tg a in + let g, env, tg = xparse_formula op k env tg b in + (mkformula_binary k (mkIff k) term f g, env, tg) + | [|ty; a; b|] + when EConstr.eq_constr sigma l eq && is_convertible genv sigma ty bool + -> + let f, env, tg = xparse_formula bool_op Mc.IsBool env tg a in + let g, env, tg = xparse_formula bool_op Mc.IsBool env tg b in + (mkformula_binary Mc.IsProp mkEQ term f g, env, tg) + | [|a|] when EConstr.eq_constr sigma l op.op_not -> + let f, env, tg = xparse_formula op k env tg a in + (Mc.NOT (k, f), env, tg) + | _ -> parse_atom k env tg term ) + | Prod (typ, a, b) + when kind_is_prop k + && (typ.binder_name = Anonymous || EConstr.Vars.noccurn sigma 1 b) -> + let f, env, tg = xparse_formula op k env tg a in + let g, env, tg = xparse_formula op k env tg b in + (mkformula_binary Mc.IsProp (mkIMPL Mc.IsProp) term f g, env, tg) + | _ -> + if EConstr.eq_constr sigma term op.op_tt then (Mc.TT k, env, tg) + else if EConstr.eq_constr sigma term op.op_ff then Mc.(FF k, env, tg) + else (Mc.X (k, term), env, tg) + in + xparse_formula prop_op Mc.IsProp env tg (*Reductionops.whd_zeta*) term - (* let dump_bool b = Lazy.force (if b then coq_true else coq_false)*) +(* let dump_bool b = Lazy.force (if b then coq_true else coq_false)*) - let dump_kind k = - Lazy.force (match k with Mc.IsProp -> coq_IsProp | Mc.IsBool -> coq_IsBool) +let dump_kind k = + Lazy.force (match k with Mc.IsProp -> coq_IsProp | Mc.IsBool -> coq_IsBool) - let dump_formula typ dump_atom f = - let app_ctor c args = - EConstr.mkApp - ( Lazy.force c - , Array.of_list - ( typ :: Lazy.force coq_eKind :: Lazy.force coq_unit - :: Lazy.force coq_unit :: args ) ) - in - let rec xdump f = - match f with - | Mc.TT k -> app_ctor coq_TT [dump_kind k] - | Mc.FF k -> app_ctor coq_FF [dump_kind k] - | Mc.AND (k, x, y) -> app_ctor coq_AND [dump_kind k; xdump x; xdump y] - | Mc.OR (k, x, y) -> app_ctor coq_OR [dump_kind k; xdump x; xdump y] - | Mc.IMPL (k, x, _, y) -> - app_ctor coq_IMPL - [ dump_kind k - ; xdump x - ; EConstr.mkApp (Lazy.force coq_None, [|Lazy.force coq_unit|]) - ; xdump y ] - | Mc.NOT (k, x) -> app_ctor coq_NOT [dump_kind k; xdump x] - | Mc.IFF (k, x, y) -> app_ctor coq_IFF [dump_kind k; xdump x; xdump y] - | Mc.EQ (x, y) -> app_ctor coq_EQ [xdump x; xdump y] - | Mc.A (k, x, _) -> - app_ctor coq_Atom [dump_kind k; dump_atom x; Lazy.force coq_tt] - | Mc.X (k, t) -> app_ctor coq_X [dump_kind k; t] - in - xdump f - - let prop_env_of_formula gl form = - Mc.( - let rec doit env = function - | TT _ | FF _ | A (_, _, _) -> env - | X (b, t) -> fst (Env.compute_rank_add env t b) - | AND (b, f1, f2) - |OR (b, f1, f2) - |IMPL (b, f1, _, f2) - |IFF (b, f1, f2) -> - doit (doit env f1) f2 - | NOT (b, f) -> doit env f - | EQ (f1, f2) -> doit (doit env f1) f2 - in - doit (Env.empty gl) form) - - let var_env_of_formula form = - let rec vars_of_expr = function - | Mc.PEX n -> ISet.singleton (CoqToCaml.positive n) - | Mc.PEc z -> ISet.empty - | Mc.PEadd (e1, e2) | Mc.PEmul (e1, e2) | Mc.PEsub (e1, e2) -> - ISet.union (vars_of_expr e1) (vars_of_expr e2) - | Mc.PEopp e | Mc.PEpow (e, _) -> vars_of_expr e - in - let vars_of_atom {Mc.flhs; Mc.fop; Mc.frhs} = - ISet.union (vars_of_expr flhs) (vars_of_expr frhs) +let dump_formula typ dump_atom f = + let app_ctor c args = + EConstr.mkApp + ( Lazy.force c + , Array.of_list + ( typ :: Lazy.force coq_eKind :: Lazy.force coq_unit + :: Lazy.force coq_unit :: args ) ) + in + let rec xdump f = + match f with + | Mc.TT k -> app_ctor coq_TT [dump_kind k] + | Mc.FF k -> app_ctor coq_FF [dump_kind k] + | Mc.AND (k, x, y) -> app_ctor coq_AND [dump_kind k; xdump x; xdump y] + | Mc.OR (k, x, y) -> app_ctor coq_OR [dump_kind k; xdump x; xdump y] + | Mc.IMPL (k, x, _, y) -> + app_ctor coq_IMPL + [ dump_kind k + ; xdump x + ; EConstr.mkApp (Lazy.force coq_None, [|Lazy.force coq_unit|]) + ; xdump y ] + | Mc.NOT (k, x) -> app_ctor coq_NOT [dump_kind k; xdump x] + | Mc.IFF (k, x, y) -> app_ctor coq_IFF [dump_kind k; xdump x; xdump y] + | Mc.EQ (x, y) -> app_ctor coq_EQ [xdump x; xdump y] + | Mc.A (k, x, _) -> + app_ctor coq_Atom [dump_kind k; dump_atom x; Lazy.force coq_tt] + | Mc.X (k, t) -> app_ctor coq_X [dump_kind k; t] + in + xdump f + +let prop_env_of_formula gl form = + Mc.( + let rec doit env = function + | TT _ | FF _ | A (_, _, _) -> env + | X (b, t) -> fst (Env.compute_rank_add env t b) + | AND (b, f1, f2) | OR (b, f1, f2) | IMPL (b, f1, _, f2) | IFF (b, f1, f2) + -> + doit (doit env f1) f2 + | NOT (b, f) -> doit env f + | EQ (f1, f2) -> doit (doit env f1) f2 in - Mc.( - let rec doit = function - | TT _ | FF _ | X _ -> ISet.empty - | A (_, a, (t, c)) -> vars_of_atom a - | AND (_, f1, f2) - |OR (_, f1, f2) - |IMPL (_, f1, _, f2) - |IFF (_, f1, f2) - |EQ (f1, f2) -> - ISet.union (doit f1) (doit f2) - | NOT (_, f) -> doit f - in - doit form) - - type 'cst dump_expr = - { (* 'cst is the type of the syntactic constants *) - interp_typ : EConstr.constr - ; dump_cst : 'cst -> EConstr.constr - ; dump_add : EConstr.constr - ; dump_sub : EConstr.constr - ; dump_opp : EConstr.constr - ; dump_mul : EConstr.constr - ; dump_pow : EConstr.constr - ; dump_pow_arg : Mc.n -> EConstr.constr - ; dump_op_prop : (Mc.op2 * EConstr.constr) list - ; dump_op_bool : (Mc.op2 * EConstr.constr) list } - - let dump_zexpr = - lazy - { interp_typ = Lazy.force coq_Z - ; dump_cst = dump_z - ; dump_add = Lazy.force coq_Zplus - ; dump_sub = Lazy.force coq_Zminus - ; dump_opp = Lazy.force coq_Zopp - ; dump_mul = Lazy.force coq_Zmult - ; dump_pow = Lazy.force coq_Zpower - ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n))) - ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) zop_table_prop - ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) zop_table_bool - } - - let dump_qexpr = - lazy - { interp_typ = Lazy.force coq_Q - ; dump_cst = dump_q - ; dump_add = Lazy.force coq_Qplus - ; dump_sub = Lazy.force coq_Qminus - ; dump_opp = Lazy.force coq_Qopp - ; dump_mul = Lazy.force coq_Qmult - ; dump_pow = Lazy.force coq_Qpower - ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n))) - ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) qop_table_prop - ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) qop_table_bool - } - - let rec dump_Rcst_as_R cst = - match cst with - | Mc.C0 -> Lazy.force coq_R0 - | Mc.C1 -> Lazy.force coq_R1 - | Mc.CQ q -> EConstr.mkApp (Lazy.force coq_IQR, [|dump_q q|]) - | Mc.CZ z -> EConstr.mkApp (Lazy.force coq_IZR, [|dump_z z|]) - | Mc.CPlus (x, y) -> - EConstr.mkApp - (Lazy.force coq_Rplus, [|dump_Rcst_as_R x; dump_Rcst_as_R y|]) - | Mc.CMinus (x, y) -> - EConstr.mkApp - (Lazy.force coq_Rminus, [|dump_Rcst_as_R x; dump_Rcst_as_R y|]) - | Mc.CMult (x, y) -> - EConstr.mkApp - (Lazy.force coq_Rmult, [|dump_Rcst_as_R x; dump_Rcst_as_R y|]) - | Mc.CPow (x, y) -> ( - match y with - | Mc.Inl z -> - EConstr.mkApp (Lazy.force coq_powerZR, [|dump_Rcst_as_R x; dump_z z|]) - | Mc.Inr n -> - EConstr.mkApp (Lazy.force coq_Rpower, [|dump_Rcst_as_R x; dump_nat n|]) - ) - | Mc.CInv t -> EConstr.mkApp (Lazy.force coq_Rinv, [|dump_Rcst_as_R t|]) - | Mc.COpp t -> EConstr.mkApp (Lazy.force coq_Ropp, [|dump_Rcst_as_R t|]) - - let dump_rexpr = - lazy - { interp_typ = Lazy.force coq_R - ; dump_cst = dump_Rcst_as_R - ; dump_add = Lazy.force coq_Rplus - ; dump_sub = Lazy.force coq_Rminus - ; dump_opp = Lazy.force coq_Ropp - ; dump_mul = Lazy.force coq_Rmult - ; dump_pow = Lazy.force coq_Rpower - ; dump_pow_arg = (fun n -> dump_nat (CamlToCoq.nat (CoqToCaml.n n))) - ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) rop_table_prop - ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) rop_table_bool - } - - let prodn n env b = - let rec prodrec = function - | 0, env, b -> b - | n, (v, t) :: l, b -> - prodrec (n - 1, l, EConstr.mkProd (make_annot v Sorts.Relevant, t, b)) - | _ -> assert false + doit (Env.empty gl) form) + +let var_env_of_formula form = + let rec vars_of_expr = function + | Mc.PEX n -> ISet.singleton (CoqToCaml.positive n) + | Mc.PEc z -> ISet.empty + | Mc.PEadd (e1, e2) | Mc.PEmul (e1, e2) | Mc.PEsub (e1, e2) -> + ISet.union (vars_of_expr e1) (vars_of_expr e2) + | Mc.PEopp e | Mc.PEpow (e, _) -> vars_of_expr e + in + let vars_of_atom {Mc.flhs; Mc.fop; Mc.frhs} = + ISet.union (vars_of_expr flhs) (vars_of_expr frhs) + in + Mc.( + let rec doit = function + | TT _ | FF _ | X _ -> ISet.empty + | A (_, a, (t, c)) -> vars_of_atom a + | AND (_, f1, f2) + |OR (_, f1, f2) + |IMPL (_, f1, _, f2) + |IFF (_, f1, f2) + |EQ (f1, f2) -> + ISet.union (doit f1) (doit f2) + | NOT (_, f) -> doit f in - prodrec (n, env, b) + doit form) + +type 'cst dump_expr = + { (* 'cst is the type of the syntactic constants *) + interp_typ : EConstr.constr + ; dump_cst : 'cst -> EConstr.constr + ; dump_add : EConstr.constr + ; dump_sub : EConstr.constr + ; dump_opp : EConstr.constr + ; dump_mul : EConstr.constr + ; dump_pow : EConstr.constr + ; dump_pow_arg : Mc.n -> EConstr.constr + ; dump_op_prop : (Mc.op2 * EConstr.constr) list + ; dump_op_bool : (Mc.op2 * EConstr.constr) list } + +let dump_zexpr = + lazy + { interp_typ = Lazy.force coq_Z + ; dump_cst = dump_z + ; dump_add = Lazy.force coq_Zplus + ; dump_sub = Lazy.force coq_Zminus + ; dump_opp = Lazy.force coq_Zopp + ; dump_mul = Lazy.force coq_Zmult + ; dump_pow = Lazy.force coq_Zpower + ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n))) + ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) zop_table_prop + ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) zop_table_bool + } + +let dump_qexpr = + lazy + { interp_typ = Lazy.force coq_Q + ; dump_cst = dump_q + ; dump_add = Lazy.force coq_Qplus + ; dump_sub = Lazy.force coq_Qminus + ; dump_opp = Lazy.force coq_Qopp + ; dump_mul = Lazy.force coq_Qmult + ; dump_pow = Lazy.force coq_Qpower + ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n))) + ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) qop_table_prop + ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) qop_table_bool + } + +let rec dump_Rcst_as_R cst = + match cst with + | Mc.C0 -> Lazy.force coq_R0 + | Mc.C1 -> Lazy.force coq_R1 + | Mc.CQ q -> EConstr.mkApp (Lazy.force coq_IQR, [|dump_q q|]) + | Mc.CZ z -> EConstr.mkApp (Lazy.force coq_IZR, [|dump_z z|]) + | Mc.CPlus (x, y) -> + EConstr.mkApp (Lazy.force coq_Rplus, [|dump_Rcst_as_R x; dump_Rcst_as_R y|]) + | Mc.CMinus (x, y) -> + EConstr.mkApp (Lazy.force coq_Rminus, [|dump_Rcst_as_R x; dump_Rcst_as_R y|]) + | Mc.CMult (x, y) -> + EConstr.mkApp (Lazy.force coq_Rmult, [|dump_Rcst_as_R x; dump_Rcst_as_R y|]) + | Mc.CPow (x, y) -> ( + match y with + | Mc.Inl z -> + EConstr.mkApp (Lazy.force coq_powerZR, [|dump_Rcst_as_R x; dump_z z|]) + | Mc.Inr n -> + EConstr.mkApp (Lazy.force coq_Rpower, [|dump_Rcst_as_R x; dump_nat n|]) ) + | Mc.CInv t -> EConstr.mkApp (Lazy.force coq_Rinv, [|dump_Rcst_as_R t|]) + | Mc.COpp t -> EConstr.mkApp (Lazy.force coq_Ropp, [|dump_Rcst_as_R t|]) + +let dump_rexpr = + lazy + { interp_typ = Lazy.force coq_R + ; dump_cst = dump_Rcst_as_R + ; dump_add = Lazy.force coq_Rplus + ; dump_sub = Lazy.force coq_Rminus + ; dump_opp = Lazy.force coq_Ropp + ; dump_mul = Lazy.force coq_Rmult + ; dump_pow = Lazy.force coq_Rpower + ; dump_pow_arg = (fun n -> dump_nat (CamlToCoq.nat (CoqToCaml.n n))) + ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) rop_table_prop + ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) rop_table_bool + } + +let prodn n env b = + let rec prodrec = function + | 0, env, b -> b + | n, (v, t) :: l, b -> + prodrec (n - 1, l, EConstr.mkProd (make_annot v Sorts.Relevant, t, b)) + | _ -> assert false + in + prodrec (n, env, b) - (** [make_goal_of_formula depxr vars props form] where +(** [make_goal_of_formula depxr vars props form] where - vars is an environment for the arithmetic variables occurring in form - props is an environment for the propositions occurring in form @return a goal where all the variables and propositions of the formula are quantified *) - let eKind = function - | Mc.IsProp -> EConstr.mkProp - | Mc.IsBool -> Lazy.force coq_bool +let eKind = function + | Mc.IsProp -> EConstr.mkProp + | Mc.IsBool -> Lazy.force coq_bool - let make_goal_of_formula gl dexpr form = - let vars_idx = - List.mapi - (fun i v -> (v, i + 1)) - (ISet.elements (var_env_of_formula form)) - in - (* List.iter (fun (v,i) -> Printf.fprintf stdout "var %i has index %i\n" v i) vars_idx ;*) - let props = prop_env_of_formula gl form in - let fresh_var str i = Names.Id.of_string (str ^ string_of_int i) in - let fresh_prop str i = Names.Id.of_string (str ^ string_of_int i) in - let vars_n = - List.map (fun (_, i) -> (fresh_var "__x" i, dexpr.interp_typ)) vars_idx - in - let props_n = - List.mapi - (fun i (_, k) -> (fresh_prop "__p" (i + 1), eKind k)) - (Env.elements props) - in - let var_name_pos = - List.map2 (fun (idx, _) (id, _) -> (id, idx)) vars_idx vars_n - in - let dump_expr i e = - let rec dump_expr = function - | Mc.PEX n -> - EConstr.mkRel (i + List.assoc (CoqToCaml.positive n) vars_idx) - | Mc.PEc z -> dexpr.dump_cst z - | Mc.PEadd (e1, e2) -> - EConstr.mkApp (dexpr.dump_add, [|dump_expr e1; dump_expr e2|]) - | Mc.PEsub (e1, e2) -> - EConstr.mkApp (dexpr.dump_sub, [|dump_expr e1; dump_expr e2|]) - | Mc.PEopp e -> EConstr.mkApp (dexpr.dump_opp, [|dump_expr e|]) - | Mc.PEmul (e1, e2) -> - EConstr.mkApp (dexpr.dump_mul, [|dump_expr e1; dump_expr e2|]) - | Mc.PEpow (e, n) -> - EConstr.mkApp (dexpr.dump_pow, [|dump_expr e; dexpr.dump_pow_arg n|]) - in - dump_expr e - in - let mkop_prop op e1 e2 = - try EConstr.mkApp (List.assoc op dexpr.dump_op_prop, [|e1; e2|]) - with Not_found -> - EConstr.mkApp (Lazy.force coq_eq, [|dexpr.interp_typ; e1; e2|]) - in - let dump_cstr_prop i {Mc.flhs; Mc.fop; Mc.frhs} = - mkop_prop fop (dump_expr i flhs) (dump_expr i frhs) - in - let mkop_bool op e1 e2 = - try EConstr.mkApp (List.assoc op dexpr.dump_op_bool, [|e1; e2|]) - with Not_found -> - EConstr.mkApp (Lazy.force coq_eq, [|dexpr.interp_typ; e1; e2|]) - in - let dump_cstr_bool i {Mc.flhs; Mc.fop; Mc.frhs} = - mkop_bool fop (dump_expr i flhs) (dump_expr i frhs) - in - let rec xdump_prop pi xi f = - match f with - | Mc.TT _ -> Lazy.force coq_True - | Mc.FF _ -> Lazy.force coq_False - | Mc.AND (_, x, y) -> - EConstr.mkApp - (Lazy.force coq_and, [|xdump_prop pi xi x; xdump_prop pi xi y|]) - | Mc.OR (_, x, y) -> - EConstr.mkApp - (Lazy.force coq_or, [|xdump_prop pi xi x; xdump_prop pi xi y|]) - | Mc.IFF (_, x, y) -> - EConstr.mkApp - (Lazy.force coq_iff, [|xdump_prop pi xi x; xdump_prop pi xi y|]) - | Mc.IMPL (_, x, _, y) -> - EConstr.mkArrow (xdump_prop pi xi x) Sorts.Relevant - (xdump_prop (pi + 1) (xi + 1) y) - | Mc.NOT (_, x) -> - EConstr.mkArrow (xdump_prop pi xi x) Sorts.Relevant - (Lazy.force coq_False) - | Mc.EQ (x, y) -> - EConstr.mkApp - ( Lazy.force coq_eq - , [|Lazy.force coq_bool; xdump_bool pi xi x; xdump_bool pi xi y|] ) - | Mc.A (_, x, _) -> dump_cstr_prop xi x - | Mc.X (_, t) -> - let idx = Env.get_rank props t in - EConstr.mkRel (pi + idx) - and xdump_bool pi xi f = - match f with - | Mc.TT _ -> Lazy.force coq_true - | Mc.FF _ -> Lazy.force coq_false - | Mc.AND (_, x, y) -> - EConstr.mkApp - (Lazy.force coq_andb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) - | Mc.OR (_, x, y) -> - EConstr.mkApp - (Lazy.force coq_orb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) - | Mc.IFF (_, x, y) -> - EConstr.mkApp - (Lazy.force coq_eqb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) - | Mc.IMPL (_, x, _, y) -> - EConstr.mkApp - (Lazy.force coq_implb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) - | Mc.NOT (_, x) -> - EConstr.mkApp (Lazy.force coq_negb, [|xdump_bool pi xi x|]) - | Mc.EQ (x, y) -> assert false - | Mc.A (_, x, _) -> dump_cstr_bool xi x - | Mc.X (_, t) -> - let idx = Env.get_rank props t in - EConstr.mkRel (pi + idx) - in - let nb_vars = List.length vars_n in - let nb_props = List.length props_n in - (* Printf.fprintf stdout "NBProps : %i\n" nb_props ;*) - let subst_prop p = - let idx = Env.get_rank props p in - EConstr.mkVar (Names.Id.of_string (Printf.sprintf "__p%i" idx)) +let make_goal_of_formula gl dexpr form = + let vars_idx = + List.mapi (fun i v -> (v, i + 1)) (ISet.elements (var_env_of_formula form)) + in + (* List.iter (fun (v,i) -> Printf.fprintf stdout "var %i has index %i\n" v i) vars_idx ;*) + let props = prop_env_of_formula gl form in + let fresh_var str i = Names.Id.of_string (str ^ string_of_int i) in + let fresh_prop str i = Names.Id.of_string (str ^ string_of_int i) in + let vars_n = + List.map (fun (_, i) -> (fresh_var "__x" i, dexpr.interp_typ)) vars_idx + in + let props_n = + List.mapi + (fun i (_, k) -> (fresh_prop "__p" (i + 1), eKind k)) + (Env.elements props) + in + let var_name_pos = + List.map2 (fun (idx, _) (id, _) -> (id, idx)) vars_idx vars_n + in + let dump_expr i e = + let rec dump_expr = function + | Mc.PEX n -> + EConstr.mkRel (i + List.assoc (CoqToCaml.positive n) vars_idx) + | Mc.PEc z -> dexpr.dump_cst z + | Mc.PEadd (e1, e2) -> + EConstr.mkApp (dexpr.dump_add, [|dump_expr e1; dump_expr e2|]) + | Mc.PEsub (e1, e2) -> + EConstr.mkApp (dexpr.dump_sub, [|dump_expr e1; dump_expr e2|]) + | Mc.PEopp e -> EConstr.mkApp (dexpr.dump_opp, [|dump_expr e|]) + | Mc.PEmul (e1, e2) -> + EConstr.mkApp (dexpr.dump_mul, [|dump_expr e1; dump_expr e2|]) + | Mc.PEpow (e, n) -> + EConstr.mkApp (dexpr.dump_pow, [|dump_expr e; dexpr.dump_pow_arg n|]) in - let form' = Mc.mapX (fun _ p -> subst_prop p) Mc.IsProp form in - ( prodn nb_props - (List.map (fun (x, y) -> (Name.Name x, y)) props_n) - (prodn nb_vars - (List.map (fun (x, y) -> (Name.Name x, y)) vars_n) - (xdump_prop (List.length vars_n) 0 form)) - , List.rev props_n - , List.rev var_name_pos - , form' ) - - (** + dump_expr e + in + let mkop_prop op e1 e2 = + try EConstr.mkApp (List.assoc op dexpr.dump_op_prop, [|e1; e2|]) + with Not_found -> + EConstr.mkApp (Lazy.force coq_eq, [|dexpr.interp_typ; e1; e2|]) + in + let dump_cstr_prop i {Mc.flhs; Mc.fop; Mc.frhs} = + mkop_prop fop (dump_expr i flhs) (dump_expr i frhs) + in + let mkop_bool op e1 e2 = + try EConstr.mkApp (List.assoc op dexpr.dump_op_bool, [|e1; e2|]) + with Not_found -> + EConstr.mkApp (Lazy.force coq_eq, [|dexpr.interp_typ; e1; e2|]) + in + let dump_cstr_bool i {Mc.flhs; Mc.fop; Mc.frhs} = + mkop_bool fop (dump_expr i flhs) (dump_expr i frhs) + in + let rec xdump_prop pi xi f = + match f with + | Mc.TT _ -> Lazy.force coq_True + | Mc.FF _ -> Lazy.force coq_False + | Mc.AND (_, x, y) -> + EConstr.mkApp + (Lazy.force coq_and, [|xdump_prop pi xi x; xdump_prop pi xi y|]) + | Mc.OR (_, x, y) -> + EConstr.mkApp + (Lazy.force coq_or, [|xdump_prop pi xi x; xdump_prop pi xi y|]) + | Mc.IFF (_, x, y) -> + EConstr.mkApp + (Lazy.force coq_iff, [|xdump_prop pi xi x; xdump_prop pi xi y|]) + | Mc.IMPL (_, x, _, y) -> + EConstr.mkArrow (xdump_prop pi xi x) Sorts.Relevant + (xdump_prop (pi + 1) (xi + 1) y) + | Mc.NOT (_, x) -> + EConstr.mkArrow (xdump_prop pi xi x) Sorts.Relevant (Lazy.force coq_False) + | Mc.EQ (x, y) -> + EConstr.mkApp + ( Lazy.force coq_eq + , [|Lazy.force coq_bool; xdump_bool pi xi x; xdump_bool pi xi y|] ) + | Mc.A (_, x, _) -> dump_cstr_prop xi x + | Mc.X (_, t) -> + let idx = Env.get_rank props t in + EConstr.mkRel (pi + idx) + and xdump_bool pi xi f = + match f with + | Mc.TT _ -> Lazy.force coq_true + | Mc.FF _ -> Lazy.force coq_false + | Mc.AND (_, x, y) -> + EConstr.mkApp + (Lazy.force coq_andb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) + | Mc.OR (_, x, y) -> + EConstr.mkApp + (Lazy.force coq_orb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) + | Mc.IFF (_, x, y) -> + EConstr.mkApp + (Lazy.force coq_eqb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) + | Mc.IMPL (_, x, _, y) -> + EConstr.mkApp + (Lazy.force coq_implb, [|xdump_bool pi xi x; xdump_bool pi xi y|]) + | Mc.NOT (_, x) -> + EConstr.mkApp (Lazy.force coq_negb, [|xdump_bool pi xi x|]) + | Mc.EQ (x, y) -> assert false + | Mc.A (_, x, _) -> dump_cstr_bool xi x + | Mc.X (_, t) -> + let idx = Env.get_rank props t in + EConstr.mkRel (pi + idx) + in + let nb_vars = List.length vars_n in + let nb_props = List.length props_n in + (* Printf.fprintf stdout "NBProps : %i\n" nb_props ;*) + let subst_prop p = + let idx = Env.get_rank props p in + EConstr.mkVar (Names.Id.of_string (Printf.sprintf "__p%i" idx)) + in + let form' = Mc.mapX (fun _ p -> subst_prop p) Mc.IsProp form in + ( prodn nb_props + (List.map (fun (x, y) -> (Name.Name x, y)) props_n) + (prodn nb_vars + (List.map (fun (x, y) -> (Name.Name x, y)) vars_n) + (xdump_prop (List.length vars_n) 0 form)) + , List.rev props_n + , List.rev var_name_pos + , form' ) + +(** * Given a conclusion and a list of affectations, rebuild a term prefixed by * the appropriate letins. * TODO: reverse the list of bindings! *) - let set l concl = - let rec xset acc = function - | [] -> acc - | e :: l -> - let name, expr, typ = e in - xset - (EConstr.mkNamedLetIn - (make_annot (Names.Id.of_string name) Sorts.Relevant) - expr typ acc) - l - in - xset concl l -end - -open M +let set l concl = + let rec xset acc = function + | [] -> acc + | e :: l -> + let name, expr, typ = e in + xset + (EConstr.mkNamedLetIn + (make_annot (Names.Id.of_string name) Sorts.Relevant) + expr typ acc) + l + in + xset concl l let coq_Branch = lazy (constr_of_ref "micromega.VarMap.Branch") let coq_Elt = lazy (constr_of_ref "micromega.VarMap.Elt") @@ -1424,14 +1389,14 @@ let rec pp_proof_term o = function | Micromega.ExProof (p, prf) -> Printf.fprintf o "Ex[%a,%a]" pp_positive p pp_proof_term prf -let rec parse_hyps gl parse_arith env tg hyps = +let rec parse_hyps (genv, sigma) parse_arith env tg hyps = match hyps with | [] -> ([], env, tg) | (i, t) :: l -> - let lhyps, env, tg = parse_hyps gl parse_arith env tg l in - if is_prop gl.env gl.sigma t then + let lhyps, env, tg = parse_hyps (genv, sigma) parse_arith env tg l in + if is_prop genv sigma t then try - let c, env, tg = parse_formula gl parse_arith env tg t in + let c, env, tg = parse_formula (genv, sigma) parse_arith env tg t in ((i, c) :: lhyps, env, tg) with ParseError -> (lhyps, env, tg) else (lhyps, env, tg) @@ -1852,19 +1817,22 @@ let clear_all_no_check = let micromega_gen parse_arith pre_process cnf spec dumpexpr prover tac = Proofview.Goal.enter (fun gl -> let sigma = Tacmach.New.project gl in + let genv = Tacmach.New.pf_env gl in let concl = Tacmach.New.pf_concl gl in let hyps = Tacmach.New.pf_hyps_types gl in try - let gl0 = {env = Tacmach.New.pf_env gl; sigma} in let hyps, concl, env = - parse_goal gl0 parse_arith (Env.empty gl0) hyps concl + parse_goal (genv, sigma) parse_arith + (Env.empty (genv, sigma)) + hyps concl in let env = Env.elements env in let spec = Lazy.force spec in let dumpexpr = Lazy.force dumpexpr in - if debug then Feedback.msg_debug (Pp.str "Env " ++ Env.pp gl0 env); + if debug then + Feedback.msg_debug (Pp.str "Env " ++ Env.pp (genv, sigma) env); match - micromega_tauto pre_process cnf spec prover env hyps concl gl0 + micromega_tauto pre_process cnf spec prover env hyps concl (env, sigma) with | Unknown -> flush stdout; @@ -1873,7 +1841,7 @@ let micromega_gen parse_arith pre_process cnf spec dumpexpr prover tac = Tacticals.New.tclFAIL 0 (Pp.str " Cannot find witness") | Prf (ids, ff', res') -> let arith_goal, props, vars, ff_arith = - make_goal_of_formula gl0 dumpexpr ff' + make_goal_of_formula (genv, sigma) dumpexpr ff' in let intro (id, _) = Tactics.introduction id in let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in @@ -1893,7 +1861,9 @@ let micromega_gen parse_arith pre_process cnf spec dumpexpr prover tac = env' ff_arith ] in let goal_props = - List.rev (List.map fst (Env.elements (prop_env_of_formula gl0 ff'))) + List.rev + (List.map fst + (Env.elements (prop_env_of_formula (genv, sigma) ff'))) in let goal_vars = List.map (fun (_, i) -> fst (List.nth env (i - 1))) vars @@ -1971,12 +1941,14 @@ let micromega_genr prover tac = in Proofview.Goal.enter (fun gl -> let sigma = Tacmach.New.project gl in + let genv = Tacmach.New.pf_env gl in let concl = Tacmach.New.pf_concl gl in let hyps = Tacmach.New.pf_hyps_types gl in try - let gl0 = {env = Tacmach.New.pf_env gl; sigma} in let hyps, concl, env = - parse_goal gl0 parse_arith (Env.empty gl0) hyps concl + parse_goal (genv, sigma) parse_arith + (Env.empty (genv, sigma)) + hyps concl in let env = Env.elements env in let spec = Lazy.force spec in @@ -1997,7 +1969,7 @@ let micromega_genr prover tac = match micromega_tauto (fun _ x -> x) - Mc.cnfQ spec prover env hyps' concl' gl0 + Mc.cnfQ spec prover env hyps' concl' (genv, sigma) with | Unknown | Model _ -> flush stdout; @@ -2010,7 +1982,7 @@ let micromega_genr prover tac = in let ff' = abstract_wrt_formula ff' ff in let arith_goal, props, vars, ff_arith = - make_goal_of_formula gl0 (Lazy.force dump_rexpr) ff' + make_goal_of_formula (genv, sigma) (Lazy.force dump_rexpr) ff' in let intro (id, _) = Tactics.introduction id in let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in @@ -2030,7 +2002,9 @@ let micromega_genr prover tac = ; micromega_order_changer res' env' ff_arith ] in let goal_props = - List.rev (List.map fst (Env.elements (prop_env_of_formula gl0 ff'))) + List.rev + (List.map fst + (Env.elements (prop_env_of_formula (genv, sigma) ff'))) in let goal_vars = List.map (fun (_, i) -> fst (List.nth env (i - 1))) vars diff --git a/plugins/micromega/zify.ml b/plugins/micromega/zify.ml index fa29e6080e..917961fdcd 100644 --- a/plugins/micromega/zify.ml +++ b/plugins/micromega/zify.ml @@ -464,13 +464,18 @@ module ECstOp = struct let cast x = CstOp x let dest = function CstOp x -> Some x | _ -> None + let isConstruct evd c = + match EConstr.kind evd c with + | Construct _ | Int _ | Float _ -> true + | _ -> false + let mk_elt evd i a = { source = a.(0) ; target = a.(1) ; inj = get_inj evd a.(3) ; cst = a.(4) ; cstinj = a.(5) - ; is_construct = EConstr.isConstruct evd a.(2) } + ; is_construct = isConstruct evd a.(2) } let get_key = 2 end @@ -979,17 +984,21 @@ let is_arrow env evd a p1 p2 = where c is the head symbol and [a] is the array of arguments. The function also transforms (x -> y) as (arrow x y) *) let get_operator barrow env evd e = - match EConstr.kind evd e with + let e' = EConstr.whd_evar evd e in + match EConstr.kind evd e' with | Prod (a, p1, p2) -> - if barrow && is_arrow env evd a p1 p2 then (arrow, [|p1; p2|]) + if barrow && is_arrow env evd a p1 p2 then (arrow, [|p1; p2|], false) else raise Not_found | App (c, a) -> ( - match EConstr.kind evd c with + let c' = EConstr.whd_evar evd c in + match EConstr.kind evd c' with | Construct _ (* e.g. Z0 , Z.pos *) | Const _ (* e.g. Z.max *) | Proj _ |Lambda _ (* e.g projections *) | Ind _ (* e.g. eq *) -> - (c, a) + (c', a, false) | _ -> raise Not_found ) - | Construct _ -> (EConstr.whd_evar evd e, [||]) + | Const _ -> (e', [||], false) + | Construct _ -> (e', [||], true) + | Int _ | Float _ -> (e', [||], true) | _ -> raise Not_found let decompose_app env evd e = @@ -1065,37 +1074,41 @@ let rec trans_expr env evd e = let inj = e.inj in let e = e.constr in try - let c, a = get_operator false env evd e in - let k, t = - find_option (match_operator env evd c a) (HConstr.find_all c !table_cache) - in - let n = Array.length a in - match k with - | CstOp {deriv = c'} -> - ECstOpT.(if c'.is_construct then Term else Prf (c'.cst, c'.cstinj)) - | UnOp {deriv = unop} -> - let prf = - trans_expr env evd - { constr = a.(n - 1) - ; typ = unop.EUnOpT.source1 - ; inj = unop.EUnOpT.inj1_t } - in - app_unop evd e unop a.(n - 1) prf - | BinOp {deriv = binop} -> - let prf1 = - trans_expr env evd - { constr = a.(n - 2) - ; typ = binop.EBinOpT.source1 - ; inj = binop.EBinOpT.inj1 } - in - let prf2 = - trans_expr env evd - { constr = a.(n - 1) - ; typ = binop.EBinOpT.source2 - ; inj = binop.EBinOpT.inj2 } + let c, a, is_constant = get_operator false env evd e in + if is_constant then Term + else + let k, t = + find_option + (match_operator env evd c a) + (HConstr.find_all c !table_cache) in - app_binop evd e binop a.(n - 2) prf1 a.(n - 1) prf2 - | d -> mkvar evd inj e + let n = Array.length a in + match k with + | CstOp {deriv = c'} -> + ECstOpT.(if c'.is_construct then Term else Prf (c'.cst, c'.cstinj)) + | UnOp {deriv = unop} -> + let prf = + trans_expr env evd + { constr = a.(n - 1) + ; typ = unop.EUnOpT.source1 + ; inj = unop.EUnOpT.inj1_t } + in + app_unop evd e unop a.(n - 1) prf + | BinOp {deriv = binop} -> + let prf1 = + trans_expr env evd + { constr = a.(n - 2) + ; typ = binop.EBinOpT.source1 + ; inj = binop.EBinOpT.inj1 } + in + let prf2 = + trans_expr env evd + { constr = a.(n - 1) + ; typ = binop.EBinOpT.source2 + ; inj = binop.EBinOpT.inj2 } + in + app_binop evd e binop a.(n - 2) prf1 a.(n - 1) prf2 + | d -> mkvar evd inj e with Not_found -> (* Feedback.msg_debug Pp.(str "Not found " ++ Termops.Internal.debug_print_constr e); *) diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml index d859fe51ab..cb58b9bcb8 100644 --- a/plugins/ssr/ssrcommon.ml +++ b/plugins/ssr/ssrcommon.ml @@ -280,7 +280,7 @@ let interp_wit wit ist gl x = sigma, Tacinterp.Value.cast (topwit wit) arg let interp_hyp ist gl (SsrHyp (loc, id)) = - let s, id' = interp_wit wit_var ist gl CAst.(make ?loc id) in + let s, id' = interp_wit wit_hyp ist gl CAst.(make ?loc id) in if not_section_id id' then s, SsrHyp (loc, id') else hyp_err ?loc "Can't clear section hypothesis " id' diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg index 89e0c9fcbe..7b584b5159 100644 --- a/plugins/ssr/ssrparser.mlg +++ b/plugins/ssr/ssrparser.mlg @@ -155,7 +155,7 @@ let pr_ssrhyp _ _ _ = pr_hyp let wit_ssrhyprep = add_genarg "ssrhyprep" (fun env sigma -> pr_hyp) let intern_hyp ist (SsrHyp (loc, id) as hyp) = - let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_var) CAst.(make ?loc id)) in + let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_hyp) CAst.(make ?loc id)) in if not_section_id id then hyp else hyp_err ?loc "Can't clear section hypothesis " id diff --git a/plugins/ssr/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg index 4a907b2795..91cd5b251c 100644 --- a/plugins/ssr/ssrvernac.mlg +++ b/plugins/ssr/ssrvernac.mlg @@ -309,9 +309,15 @@ END ~category:"deprecated" ~default:CWarnings.Enabled (fun () -> (Pp.strbrk - "SSReflect's Search command has been moved to the \ - ssrsearch module; please Require that module if you \ - still want to use SSReflect's Search command")) + "In previous versions of Coq, loading SSReflect had the effect of \ + replacing the built-in 'Search' command with an SSReflect version \ + of that command. \ + Coq's own search feature was still available via 'SearchAbout' \ + (but that alias is deprecated). \ + This replacement no longer happens; now 'Search' calls Coq's own search \ + feature even when SSReflect is loaded. \ + If you want to use SSReflect's deprecated Search command \ + instead of the built-in one, please Require the ssrsearch module.")) open G_vernac } diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml index 5dedae6388..cdd15acb0d 100644 --- a/plugins/ssrmatching/ssrmatching.ml +++ b/plugins/ssrmatching/ssrmatching.ml @@ -204,7 +204,8 @@ exception NoProgress (* comparison can be much faster than the HO one. *) let unif_EQ env sigma p c = - let evars = existential_opt_value0 sigma, Evd.universes sigma in + let env = Environ.set_universes (Evd.universes sigma) env in + let evars = existential_opt_value0 sigma in try let _ = Reduction.conv env p ~evars c in true with _ -> false let unif_EQ_args env sigma pa a = diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index 7fcb0795bd..a12a832f76 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -715,9 +715,9 @@ and detype_r d flags avoid env sigma t = (* Meta in constr are not user-parsable and are mapped to Evar *) if n = Constr_matching.special_meta then (* Using a dash to be unparsable *) - GEvar (Id.of_string_soft "CONTEXT-HOLE", []) + GEvar (CAst.make @@ Id.of_string_soft "CONTEXT-HOLE", []) else - GEvar (Id.of_string_soft ("M" ^ string_of_int n), []) + GEvar (CAst.make @@ Id.of_string_soft ("M" ^ string_of_int n), []) | Var id -> (* Discriminate between section variable and non-section variable *) (try let _ = Global.lookup_named id in GRef (GlobRef.VarRef id, None) @@ -788,12 +788,12 @@ and detype_r d flags avoid env sigma t = let l = Evd.evar_instance_array bound_to_itself_or_letin (Evd.find sigma evk) cl in let fvs,rels = List.fold_left (fun (fvs,rels) (_,c) -> match EConstr.kind sigma c with Rel n -> (fvs,Int.Set.add n rels) | Var id -> (Id.Set.add id fvs,rels) | _ -> (fvs,rels)) (Id.Set.empty,Int.Set.empty) l in let l = Evd.evar_instance_array (fun d c -> not !print_evar_arguments && (bound_to_itself_or_letin d c && not (isRel sigma c && Int.Set.mem (destRel sigma c) rels || isVar sigma c && (Id.Set.mem (destVar sigma c) fvs)))) (Evd.find sigma evk) cl in - id,l + id,List.map (fun (id,c) -> (CAst.make id,c)) l with Not_found -> Id.of_string ("X" ^ string_of_int (Evar.repr evk)), - (List.map (fun c -> (Id.of_string "__",c)) cl) + (List.map (fun c -> (CAst.make @@ Id.of_string "__",c)) cl) in - GEvar (id, + GEvar (CAst.make id, List.map (on_snd (detype d flags avoid env sigma)) l) | Ind (ind_sp,u) -> GRef (GlobRef.IndRef ind_sp, detype_instance sigma u) @@ -883,7 +883,12 @@ and detype_binder d flags bk avoid env sigma decl c = | BLetIn -> let c = detype d { flags with flg_isgoal = false } avoid env sigma (Option.get body) in (* Heuristic: we display the type if in Prop *) - let s = try Retyping.get_sort_family_of (snd env) sigma ty with _ when !Flags.in_debugger || !Flags.in_toplevel -> InType (* Can fail because of sigma missing in debugger *) in + let s = + (* It can fail if ty is an evar, or if run inside ocamldebug or the + OCaml toplevel since their printers don't have access to the proper sigma/env *) + try Retyping.get_sort_family_of (snd env) sigma ty + with Retyping.RetypeError _ -> InType + in let t = if s != InProp && not !Flags.raw_print then None else Some (detype d { flags with flg_isgoal = false } avoid env sigma ty) in GLetIn (na', c, t, r) diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 61453ff214..a5311e162d 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -1213,12 +1213,22 @@ let default_occurrences_selection ?(allowed_evars=AllowedEvars.all) ts n = (default_occurrence_test ~allowed_evars ts, List.init n (fun _ -> default_occurrence_selection)) -let apply_on_subterm env evd fixedref f test c t = +let occur_evars sigma evs c = + if Evar.Set.is_empty evs then false + else + let rec occur_rec c = match EConstr.kind sigma c with + | Evar (sp,_) when Evar.Set.mem sp evs -> raise Occur + | _ -> EConstr.iter sigma occur_rec c + in + try occur_rec c; false with Occur -> true + +let apply_on_subterm env evd fixed f test c t = let test = test env evd c in let prc env evd = Termops.Internal.print_constr_env env evd in let evdref = ref evd in + let fixedref = ref fixed in let rec applyrec (env,(k,c) as acc) t = - if Evar.Set.exists (fun fixed -> occur_evar !evdref fixed t) !fixedref then + if occur_evars !evdref !fixedref t then match EConstr.kind !evdref t with | Evar (ev, args) when Evar.Set.mem ev !fixedref -> t | _ -> map_constr_with_binders_left_to_right !evdref @@ -1231,7 +1241,8 @@ let apply_on_subterm env evd fixedref f test c t = try test env !evdref k c t with e when CErrors.noncritical e -> assert false in if b then (if debug_ho_unification () then Feedback.msg_debug (Pp.str "succeeded"); - let evd', t' = f !evdref k t in + let evd', fixed, t' = f !evdref !fixedref k t in + fixedref := fixed; evdref := evd'; t') else ( if debug_ho_unification () then Feedback.msg_debug (Pp.str "failed"); @@ -1240,7 +1251,7 @@ let apply_on_subterm env evd fixedref f test c t = applyrec acc t)) in let t' = applyrec (env,(0,c)) t in - !evdref, t' + !evdref, !fixedref, t' let filter_possible_projections evd c ty ctxt args = (* Since args in the types will be replaced by holes, we count the @@ -1377,8 +1388,7 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = | _, _, [] -> [] | _ -> anomaly (Pp.str "Signature or instance are shorter than the occurrences list.") in - let fixed = ref Evar.Set.empty in - let rec set_holes env_rhs evd rhs = function + let rec set_holes env_rhs evd fixed rhs = function | (id,idty,c,cty,evsref,filter,occs)::subst -> let c = nf_evar evd c in if debug_ho_unification () then @@ -1387,7 +1397,7 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = prc env_rhs evd c ++ str" in " ++ prc env_rhs evd rhs); let occ = ref 1 in - let set_var evd k inst = + let set_var evd fixed k inst = let oc = !occ in if debug_ho_unification () then (Feedback.msg_debug Pp.(str"Found one occurrence"); @@ -1395,10 +1405,10 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = incr occ; match occs with | AtOccurrences occs -> - if Locusops.is_selected oc occs then evd, mkVar id.binder_name - else evd, inst + if Locusops.is_selected oc occs then evd, fixed, mkVar id.binder_name + else evd, fixed, inst | Unspecified prefer_abstraction -> - let evd, evty = set_holes env_rhs evd cty subst in + let evd, fixed, evty = set_holes env_rhs evd fixed cty subst in let evty = nf_evar evd evty in if debug_ho_unification () then Feedback.msg_debug Pp.(str"abstracting one occurrence " ++ prc env_rhs evd inst ++ @@ -1414,21 +1424,21 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = env_evar_unf evd evty else evd, evty in let (evd, evk) = new_pure_evar sign evd evty ~filter in + let fixed = Evar.Set.add evk fixed in evsref := (evk,evty,inst,prefer_abstraction)::!evsref; - fixed := Evar.Set.add evk !fixed; - evd, mkEvar (evk, instance) + evd, fixed, mkEvar (evk, instance) in - let evd, rhs' = apply_on_subterm env_rhs evd fixed set_var test c rhs in + let evd, fixed, rhs' = apply_on_subterm env_rhs evd fixed set_var test c rhs in if debug_ho_unification () then Feedback.msg_debug Pp.(str"abstracted: " ++ prc env_rhs evd rhs'); let () = check_selected_occs env_rhs evd c !occ occs in let env_rhs' = push_named (NamedDecl.LocalAssum (id,idty)) env_rhs in - set_holes env_rhs' evd rhs' subst - | [] -> evd, rhs in + set_holes env_rhs' evd fixed rhs' subst + | [] -> evd, fixed, rhs in let subst = make_subst (ctxt,args,argoccs) in - let evd, rhs' = set_holes env_rhs evd rhs subst in + let evd, _, rhs' = set_holes env_rhs evd Evar.Set.empty rhs subst in let rhs' = nf_evar evd rhs' in (* Thin evars making the term typable in env_evar *) let evd, rhs' = thin_evars env_evar evd ctxt rhs' in diff --git a/pretyping/evardefine.ml b/pretyping/evardefine.ml index f33030d6a4..eaf8c65811 100644 --- a/pretyping/evardefine.ml +++ b/pretyping/evardefine.ml @@ -175,10 +175,7 @@ let define_evar_as_sort env evd (ev,args) = let evd' = Evd.define ev (mkSort s) evd in Evd.set_leq_sort env evd' (Sorts.super s) (ESorts.kind evd' sort), s -(* Propagation of constraints through application and abstraction: - Given a type constraint on a functional term, returns the type - constraint on its domain and codomain. If the input constraint is - an evar instantiate it with the product of 2 new evars. *) +(* Unify with unknown array *) let rec presplit env sigma c = let c = Reductionops.whd_all env sigma c in @@ -189,25 +186,6 @@ let rec presplit env sigma c = presplit env sigma (mkApp (lam, args)) | _ -> sigma, c -let split_tycon ?loc env evd tycon = - match tycon with - | None -> evd,(make_annot Anonymous Relevant,None,None) - | Some c -> - let evd, c = presplit env evd c in - let evd, na, dom, rng = match EConstr.kind evd c with - | Prod (na,dom,rng) -> evd, na, dom, rng - | Evar ev -> - let (evd,prod) = define_evar_as_product env evd ev in - let (na,dom,rng) = destProd evd prod in - let anon = {na with binder_name = Anonymous} in - evd, anon, dom, rng - | _ -> - (* XXX no error to allow later coercion? Not sure if possible with funclass *) - error_not_product ?loc env evd c - in - evd, (na, mk_tycon dom, mk_tycon rng) - - let define_pure_evar_as_array env sigma evk = let evi = Evd.find_undefined sigma evk in let evenv = evar_env env evi in diff --git a/pretyping/evardefine.mli b/pretyping/evardefine.mli index e5c3f8baa1..5702e169c8 100644 --- a/pretyping/evardefine.mli +++ b/pretyping/evardefine.mli @@ -8,7 +8,6 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -open Names open EConstr open Evd open Environ @@ -31,10 +30,6 @@ val mk_valcon : constr -> val_constraint val evar_absorb_arguments : env -> evar_map -> existential -> constr list -> evar_map * existential -val split_tycon : - ?loc:Loc.t -> env -> evar_map -> type_constraint -> - evar_map * (Name.t Context.binder_annot * type_constraint * type_constraint) - val split_as_array : env -> evar_map -> type_constraint -> evar_map * type_constraint (** If the constraint can be made to look like [array A] return [A], @@ -51,3 +46,6 @@ val define_evar_as_sort : env -> evar_map -> existential -> evar_map * Sorts.t val pr_tycon : env -> evar_map -> type_constraint -> Pp.t +(** Used for bidi heuristic when typing lambdas. Transforms an applied + evar to an evar with bigger context (ie ?X e to ?X'@{y=e}). *) +val presplit : env -> evar_map -> EConstr.t -> evar_map * EConstr.t diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml index 5bd26be823..dc5fd80f9e 100644 --- a/pretyping/glob_ops.ml +++ b/pretyping/glob_ops.ml @@ -128,7 +128,7 @@ let fix_kind_eq k1 k2 = match k1, k2 with | (GFix _ | GCoFix _), _ -> false let instance_eq f (x1,c1) (x2,c2) = - Id.equal x1 x2 && f c1 c2 + Id.equal x1.CAst.v x2.CAst.v && f c1 c2 let mk_glob_constr_eq f c1 c2 = match DAst.get c1, DAst.get c2 with | GRef (gr1, u1), GRef (gr2, u2) -> @@ -136,7 +136,7 @@ let mk_glob_constr_eq f c1 c2 = match DAst.get c1, DAst.get c2 with Option.equal (List.equal glob_level_eq) u1 u2 | GVar id1, GVar id2 -> Id.equal id1 id2 | GEvar (id1, arg1), GEvar (id2, arg2) -> - Id.equal id1 id2 && List.equal (instance_eq f) arg1 arg2 + Id.equal id1.CAst.v id2.CAst.v && List.equal (instance_eq f) arg1 arg2 | GPatVar k1, GPatVar k2 -> matching_var_kind_eq k1 k2 | GApp (f1, arg1), GApp (f2, arg2) -> f f1 f2 && List.equal f arg1 arg2 diff --git a/pretyping/glob_term.ml b/pretyping/glob_term.ml index 526eac6f1e..a49c8abe26 100644 --- a/pretyping/glob_term.ml +++ b/pretyping/glob_term.ml @@ -75,7 +75,7 @@ type 'a glob_constr_r = | GVar of Id.t (** An identifier that cannot be regarded as "GRef". Bound variables are typically represented this way. *) - | GEvar of existential_name * (Id.t * 'a glob_constr_g) list + | GEvar of existential_name CAst.t * (lident * 'a glob_constr_g) list | GPatVar of Evar_kinds.matching_var_kind (** Used for patterns only *) | GApp of 'a glob_constr_g * 'a glob_constr_g list | GLambda of Name.t * binding_kind * 'a glob_constr_g * 'a glob_constr_g diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml index 1e8441dd8a..1dddc5622d 100644 --- a/pretyping/pretype_errors.ml +++ b/pretyping/pretype_errors.ml @@ -48,7 +48,7 @@ type pretype_error = | CannotUnifyBindingType of constr * constr | CannotGeneralize of constr | NoOccurrenceFound of constr * Id.t option - | CannotFindWellTypedAbstraction of constr * constr list * (env * type_error) option + | CannotFindWellTypedAbstraction of constr * constr list * (env * pretype_error) option | WrongAbstractionType of Name.t * constr * types * types | AbstractionOverMeta of Name.t * Name.t | NonLinearUnification of Name.t * constr diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli index 45997e9a66..714d68165e 100644 --- a/pretyping/pretype_errors.mli +++ b/pretyping/pretype_errors.mli @@ -54,7 +54,7 @@ type pretype_error = | CannotUnifyBindingType of constr * constr | CannotGeneralize of constr | NoOccurrenceFound of constr * Id.t option - | CannotFindWellTypedAbstraction of constr * constr list * (env * type_error) option + | CannotFindWellTypedAbstraction of constr * constr list * (env * pretype_error) option | WrongAbstractionType of Name.t * constr * types * types | AbstractionOverMeta of Name.t * Name.t | NonLinearUnification of Name.t * constr @@ -132,7 +132,7 @@ val error_cannot_unify : ?loc:Loc.t -> env -> Evd.evar_map -> val error_cannot_unify_local : env -> Evd.evar_map -> constr * constr * constr -> 'b val error_cannot_find_well_typed_abstraction : env -> Evd.evar_map -> - constr -> constr list -> (env * type_error) option -> 'b + constr -> constr list -> (env * pretype_error) option -> 'b val error_wrong_abstraction_type : env -> Evd.evar_map -> Name.t -> constr -> types -> types -> 'b diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index b9825b6a92..268ad2ae56 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -365,9 +365,9 @@ let inh_conv_coerce_to_tycon ?loc ~program_mode resolve_tc env sigma j = functio | Some t -> Coercion.inh_conv_coerce_to ?loc ~program_mode resolve_tc !!env sigma j t -let check_instance loc subst = function +let check_instance subst = function | [] -> () - | (id,_) :: _ -> + | (CAst.{loc;v=id},_) :: _ -> if List.mem_assoc id subst then user_err ?loc (Id.print id ++ str "appears more than once.") else @@ -493,7 +493,7 @@ type 'a pretype_fun = ?loc:Loc.t -> program_mode:bool -> poly:bool -> bool -> ty type pretyper = { pretype_ref : pretyper -> GlobRef.t * glob_level list option -> unsafe_judgment pretype_fun; pretype_var : pretyper -> Id.t -> unsafe_judgment pretype_fun; - pretype_evar : pretyper -> existential_name * (Id.t * glob_constr) list -> unsafe_judgment pretype_fun; + pretype_evar : pretyper -> existential_name CAst.t * (lident * glob_constr) list -> unsafe_judgment pretype_fun; pretype_patvar : pretyper -> Evar_kinds.matching_var_kind -> unsafe_judgment pretype_fun; pretype_app : pretyper -> glob_constr * glob_constr list -> unsafe_judgment pretype_fun; pretype_lambda : pretyper -> Name.t * binding_kind * glob_constr * glob_constr -> unsafe_judgment pretype_fun; @@ -587,10 +587,10 @@ let pretype_instance self ~program_mode ~poly resolve_tc env sigma loc hyps evk strbrk " is not well-typed.") in let sigma, c, update = try - let c = List.assoc id update in + let c = snd (List.find (fun (CAst.{v=id'},c) -> Id.equal id id') update) in let sigma, c = eval_pretyper self ~program_mode ~poly resolve_tc (mk_tycon t) env sigma c in check_body sigma id (Some c.uj_val); - sigma, c.uj_val, List.remove_assoc id update + sigma, c.uj_val, List.remove_first (fun (CAst.{v=id'},_) -> Id.equal id id') update with Not_found -> try let (n,b',t') = lookup_rel_id id (rel_context !!env) in @@ -609,7 +609,7 @@ let pretype_instance self ~program_mode ~poly resolve_tc env sigma loc hyps evk str " in current context: no binding for " ++ Id.print id ++ str ".") in ((id,c)::subst, update, sigma) in let subst,inst,sigma = List.fold_right f hyps ([],update,sigma) in - check_instance loc subst inst; + check_instance subst inst; sigma, List.map snd subst module Default = @@ -628,13 +628,13 @@ struct let sigma, t_id = pretype_id (fun e r t -> pretype tycon e r t) loc env sigma id in discard_trace @@ inh_conv_coerce_to_tycon ?loc ~program_mode resolve_tc env sigma t_id tycon - let pretype_evar self (id, inst) ?loc ~program_mode ~poly resolve_tc tycon env sigma = + let pretype_evar self (CAst.{v=id;loc=locid}, inst) ?loc ~program_mode ~poly resolve_tc tycon env sigma = (* Ne faudrait-il pas s'assurer que hyps est bien un sous-contexte du contexte courant, et qu'il n'y a pas de Rel "caché" *) let id = interp_ltac_id env id in let evk = try Evd.evar_key id sigma - with Not_found -> error_evar_not_found ?loc !!env sigma id in + with Not_found -> error_evar_not_found ?loc:locid !!env sigma id in let hyps = evar_filtered_context (Evd.find sigma evk) in let sigma, args = pretype_instance self ~program_mode ~poly resolve_tc env sigma loc hyps evk inst in let c = mkEvar (evk, args) in @@ -857,7 +857,7 @@ struct typing the argument, so we replace it by an existential variable *) let sigma, c_hole = new_evar env sigma ~src:(loc,Evar_kinds.InternalHole) c1 in - (sigma, make_judge c_hole c1), (c_hole, c, trace) :: bidiargs + (sigma, make_judge c_hole c1), (c_hole, c1, c, trace) :: bidiargs else let tycon = Some c1 in pretype tycon env sigma c, bidiargs @@ -886,12 +886,10 @@ struct let sigma, resj, resj_before_bidi, bidiargs = apply_rec env sigma 0 fj fj candargs [] args in let sigma, resj = refresh_template env sigma resj in let sigma, resj, otrace = inh_conv_coerce_to_tycon ?loc ~program_mode resolve_tc env sigma resj tycon in - let refine_arg n (sigma,t) (newarg,origarg,trace) = + let refine_arg n (sigma,t) (newarg,ty,origarg,trace) = (* Refine an argument (originally `origarg`) represented by an evar (`newarg`) to use typing information from the context *) - (* Recover the expected type of the argument *) - let ty = Retyping.get_type_of !!env sigma newarg in - (* Type the argument using this expected type *) + (* Type the argument using the expected type *) let sigma, j = pretype (Some ty) env sigma origarg in (* Unify the (possibly refined) existential variable with the (typechecked) original value *) @@ -925,7 +923,32 @@ struct let sigma, ty' = Coercion.inh_coerce_to_prod ?loc ~program_mode !!env sigma ty in sigma, Some ty' in - let sigma, (name',dom,rng) = split_tycon ?loc !!env sigma tycon' in + let sigma,name',dom,rng = + match tycon' with + | None -> sigma,Anonymous, None, None + | Some ty -> + let sigma, ty = Evardefine.presplit !!env sigma ty in + match EConstr.kind sigma ty with + | Prod (na,dom,rng) -> + sigma, na.binder_name, Some dom, Some rng + | Evar ev -> + (* define_evar_as_product works badly when impredicativity + is possible but not known (#12623). OTOH if we know we + are impredicative (typically Prop) we want to keep the + information when typing the body. *) + let s = Retyping.get_sort_of !!env sigma ty in + if Environ.is_impredicative_sort !!env s + || Evd.check_leq sigma (Univ.Universe.type1) (Sorts.univ_of_sort s) + then + let sigma, prod = define_evar_as_product !!env sigma ev in + let na,dom,rng = destProd sigma prod in + sigma, na.binder_name, Some dom, Some rng + else + sigma, Anonymous, None, None + | _ -> + (* XXX no error to allow later coercion? Not sure if possible with funclass *) + error_not_product ?loc !!env sigma ty + in let dom_valcon = valcon_of_tycon dom in let sigma, j = eval_type_pretyper self ~program_mode ~poly resolve_tc dom_valcon env sigma c1 in let name = {binder_name=name; binder_relevance=Sorts.relevance_of_sort j.utj_type} in @@ -934,7 +957,7 @@ struct let var',env' = push_rel ~hypnaming sigma var env in let sigma, j' = eval_pretyper self ~program_mode ~poly resolve_tc rng env' sigma c2 in let name = get_name var' in - let resj = judge_of_abstraction !!env (orelse_name name name'.binder_name) j j' in + let resj = judge_of_abstraction !!env (orelse_name name name') j j' in discard_trace @@ inh_conv_coerce_to_tycon ?loc ~program_mode resolve_tc env sigma resj tycon let pretype_prod self (name, bk, c1, c2) = diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli index c03374c59f..7bb4a6e273 100644 --- a/pretyping/pretyping.mli +++ b/pretyping/pretyping.mli @@ -148,7 +148,7 @@ type 'a pretype_fun = ?loc:Loc.t -> program_mode:bool -> poly:bool -> bool -> Ev type pretyper = { pretype_ref : pretyper -> GlobRef.t * glob_level list option -> unsafe_judgment pretype_fun; pretype_var : pretyper -> Id.t -> unsafe_judgment pretype_fun; - pretype_evar : pretyper -> existential_name * (Id.t * glob_constr) list -> unsafe_judgment pretype_fun; + pretype_evar : pretyper -> existential_name CAst.t * (lident * glob_constr) list -> unsafe_judgment pretype_fun; pretype_patvar : pretyper -> Evar_kinds.matching_var_kind -> unsafe_judgment pretype_fun; pretype_app : pretyper -> glob_constr * glob_constr list -> unsafe_judgment pretype_fun; pretype_lambda : pretyper -> Name.t * binding_kind * glob_constr * glob_constr -> unsafe_judgment pretype_fun; diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index aeb18ec322..3352bfce38 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -445,7 +445,7 @@ type state_reduction_function = let pr_state env sigma (tm,sk) = let open Pp in let pr c = Termops.Internal.print_constr_env env sigma c in - h 0 (pr tm ++ str "|" ++ cut () ++ Stack.pr pr sk) + h (pr tm ++ str "|" ++ cut () ++ Stack.pr pr sk) (*************************************) (*** Reduction Functions Operators ***) @@ -705,7 +705,7 @@ let rec whd_state_gen flags env sigma = let open Pp in let pr c = Termops.Internal.print_constr_env env sigma c in Feedback.msg_debug - (h 0 (str "<<" ++ pr x ++ + (h (str "<<" ++ pr x ++ str "|" ++ cut () ++ Stack.pr pr stack ++ str ">>")) in @@ -1094,7 +1094,8 @@ let f_conv_leq ?l2r ?reds env ?evars x y = let test_trans_conversion (f: constr Reduction.extended_conversion_function) reds env sigma x y = try let evars ev = safe_evar_value sigma ev in - let _ = f ~reds env ~evars:(evars, Evd.universes sigma) x y in + let env = Environ.set_universes (Evd.universes sigma) env in + let _ = f ~reds env ~evars x y in true with Reduction.NotConvertible -> false | e -> @@ -1112,7 +1113,8 @@ let check_conv ?(pb=Reduction.CUMUL) ?(ts=TransparentState.full) env sigma x y = | Reduction.CONV -> f_conv | Reduction.CUMUL -> f_conv_leq in - try f ~reds:ts env ~evars:(safe_evar_value sigma, Evd.universes sigma) x y; true + let env = Environ.set_universes (Evd.universes sigma) env in + try f ~reds:ts env ~evars:(safe_evar_value sigma) x y; true with Reduction.NotConvertible -> false | Univ.UniverseInconsistency _ -> false | e -> @@ -1138,8 +1140,7 @@ let sigma_check_inductive_instances cv_pb variance u1 u2 sigma = let sigma_univ_state = let open Reduction in - { compare_graph = Evd.universes; - compare_sorts = sigma_compare_sorts; + { compare_sorts = sigma_compare_sorts; compare_instances = sigma_compare_instances; compare_cumul_instances = sigma_check_inductive_instances; } @@ -1164,6 +1165,7 @@ let infer_conv_gen conv_fun ?(catch_incon=true) ?(pb=Reduction.CUMUL) | None -> let x = EConstr.Unsafe.to_constr x in let y = EConstr.Unsafe.to_constr y in + let env = Environ.set_universes (Evd.universes sigma) env in let sigma' = conv_fun pb ~l2r:false sigma ts env (sigma, sigma_univ_state) x y in diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index fc71254a46..51b228a640 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -56,7 +56,7 @@ type typeclass = { cl_impl : GlobRef.t; (* Context in which the definitions are typed. Includes both typeclass parameters and superclasses. *) - cl_context : GlobRef.t option list * Constr.rel_context; + cl_context : Constr.rel_context; (* Context of definitions and properties on defs, will not be shared *) cl_props : Constr.rel_context; @@ -97,7 +97,7 @@ let instances : instances ref = Summary.ref GlobRef.Map.empty ~name:"instances" let typeclass_univ_instance (cl, u) = assert (Univ.AUContext.size cl.cl_univs == Univ.Instance.length u); let subst_ctx c = Context.Rel.map (subst_instance_constr u) c in - { cl with cl_context = on_snd subst_ctx cl.cl_context; + { cl with cl_context = subst_ctx cl.cl_context; cl_props = subst_ctx cl.cl_props} let class_info env sigma c = @@ -178,7 +178,7 @@ let remove_instance inst = let instance_constructor (cl,u) args = - let lenpars = List.count is_local_assum (snd cl.cl_context) in + let lenpars = List.count is_local_assum cl.cl_context in let open EConstr in let pars = fst (List.chop lenpars args) in match cl.cl_impl with diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli index 3f84d08a7e..b749b978c3 100644 --- a/pretyping/typeclasses.mli +++ b/pretyping/typeclasses.mli @@ -36,9 +36,9 @@ type typeclass = { (** The class implementation: a record parameterized by the context with defs in it or a definition if the class is a singleton. This acts as the class' global identifier. *) - cl_context : GlobRef.t option list * Constr.rel_context; - (** Context in which the definitions are typed. Includes both typeclass parameters and superclasses. - The global reference gives a direct link to the class itself. *) + cl_context : Constr.rel_context; + (** Context in which the definitions are typed. + Includes both typeclass parameters and superclasses. *) cl_props : Constr.rel_context; (** Context of definitions and properties on defs, will not be shared *) diff --git a/pretyping/typing.ml b/pretyping/typing.ml index 756ccd3438..aeb3873de7 100644 --- a/pretyping/typing.ml +++ b/pretyping/typing.ml @@ -220,14 +220,15 @@ let check_allowed_sort env sigma ind c p = else Sorts.relevance_of_sort_family ksort +let check_actual_type env sigma cj t = + try Evarconv.unify_leq_delay env sigma cj.uj_type t + with Evarconv.UnableToUnify (sigma,e) -> error_actual_type env sigma cj t e + let judge_of_cast env sigma cj k tj = let expected_type = tj.utj_val in - match Evarconv.unify_leq_delay env sigma cj.uj_type expected_type with - | exception Evarconv.UnableToUnify _ -> - error_actual_type_core env sigma cj expected_type; - | sigma -> - sigma, { uj_val = mkCast (cj.uj_val, k, expected_type); - uj_type = expected_type } + let sigma = check_actual_type env sigma cj expected_type in + sigma, { uj_val = mkCast (cj.uj_val, k, expected_type); + uj_type = expected_type } let check_fix env sigma pfix = let inj c = EConstr.to_constr ~abort_on_undefined_evars:false sigma c in @@ -296,7 +297,8 @@ let judge_of_letin env name defj typj j = uj_type = subst1 defj.uj_val j.uj_type } let check_hyps_inclusion env sigma x hyps = - let evars = Evarutil.safe_evar_value sigma, Evd.universes sigma in + let env = Environ.set_universes (Evd.universes sigma) env in + let evars = Evarutil.safe_evar_value sigma in Typeops.check_hyps_inclusion env ~evars x hyps let type_of_constant env sigma (c,u) = @@ -340,7 +342,7 @@ let judge_of_array env sigma u tj defj tyj = let sigma = Evd.set_leq_sort env sigma tyj.utj_type (Sorts.sort_of_univ (Univ.Universe.make ulev)) in - let check_one sigma j = Evarconv.unify_leq_delay env sigma j.uj_type tyj.utj_val in + let check_one sigma j = check_actual_type env sigma j tyj.utj_val in let sigma = check_one sigma defj in let sigma = Array.fold_left check_one sigma tj in let arr = EConstr.of_constr @@ type_of_array env u in @@ -391,7 +393,7 @@ let rec execute env sigma cstr = let t = mkApp (mkIndU (ci.ci_ind,univs), args) in let sigma, tj = execute env sigma t in let sigma, tj = type_judgment env sigma tj in - let sigma = Evarconv.unify_leq_delay env sigma cj.uj_type tj.utj_val in + let sigma = check_actual_type env sigma cj tj.utj_val in sigma in judge_of_case env sigma ci pj iv cj lfj @@ -492,10 +494,7 @@ and execute_array env = Array.fold_left_map (execute env) let check env sigma c t = let sigma, j = execute env sigma c in - match Evarconv.unify_leq_delay env sigma j.uj_type t with - | exception Evarconv.UnableToUnify _ -> - error_actual_type_core env sigma j t - | sigma -> sigma + check_actual_type env sigma j t (* Type of a constr *) diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 207a03d80f..ccfb508964 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -134,8 +134,8 @@ let abstract_list_all env evd typ c l = | Type_errors.TypeError (env',x) -> (* FIXME: plug back the typing information *) error_cannot_find_well_typed_abstraction env evd p l None - | Pretype_errors.PretypeError (env',evd,TypingError x) -> - error_cannot_find_well_typed_abstraction env evd p l (Some (env',x)) in + | Pretype_errors.PretypeError (env',evd,e) -> + error_cannot_find_well_typed_abstraction env evd p l (Some (env',e)) in evd,(p,typp) let set_occurrences_of_last_arg n = diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml index 900ba0edb9..1420401875 100644 --- a/pretyping/vnorm.ml +++ b/pretyping/vnorm.ml @@ -218,7 +218,8 @@ and nf_evar env sigma evk stk = let t = List.fold_left fold concl hyps in let t, args = nf_args env sigma args t in let inst, args = Array.chop (List.length hyps) args in - let inst = Array.to_list inst in + (* Evar instances are reversed w.r.t. argument order *) + let inst = Array.rev_to_list inst in let c = mkApp (mkEvar (evk, inst), args) in nf_stk env sigma c t stk | _ -> diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index af105f4d63..8da1d636f0 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -227,13 +227,49 @@ let tag_var = tag Tag.variable let pr_evar pr id l = hov 0 ( - tag_evar (str "?" ++ pr_id id) ++ + tag_evar (str "?" ++ pr_lident id) ++ (match l with | [] -> mt() | l -> - let f (id,c) = pr_id id ++ str ":=" ++ pr ltop c in + let f (id,c) = pr_lident id ++ str ":=" ++ pr ltop c in str"@{" ++ hov 0 (prlist_with_sep pr_semicolon f (List.rev l)) ++ str"}")) + (* Assuming "{" and "}" brackets, prints + - if there is enough room + { a; b; c } + - otherwise + { + a; + b; + c + } + Alternatively, replace outer hv with h to get instead: + { a; + b; + c } + Replace the inner hv with hov to respectively get instead (if enough room): + { + a; b; + c + } + or + { a; b; + c } + *) + let pr_record left right pr = function + | [] -> str left ++ str " " ++ str right + | l -> + hv 0 ( + str left ++ + brk (1,String.length left) ++ + hv 0 (prlist_with_sep pr_semicolon pr l) ++ + brk (1,0) ++ + str right) + + let pr_record_body left right pr l = + let pr_defined_field (id, c) = hov 2 (pr_reference id ++ str" :=" ++ pr c) in + pr_record left right pr_defined_field l + let las = lapp let lpator = 0 let lpatrec = 0 @@ -242,11 +278,7 @@ let tag_var = tag Tag.variable let rec pr_patt sep inh p = let (strm,prec) = match CAst.(p.v) with | CPatRecord l -> - let pp (c, p) = - pr_reference c ++ spc() ++ str ":=" ++ pr_patt spc lpattop p - in - (if l = [] then str "{| |}" - else str "{| " ++ prlist_with_sep pr_semicolon pp l ++ str " |}"), lpatrec + pr_record_body "{|" "|}" (pr_patt spc lpattop) l, lpatrec | CPatAlias (p, na) -> pr_patt mt (LevelLe las) p ++ str " as " ++ pr_lname na, las @@ -287,6 +319,7 @@ let tag_var = tag Tag.variable | CPatDelimiters (k,p) -> pr_delimiters k (pr_patt mt lsimplepatt p), 1 + | CPatCast _ -> assert false in @@ -464,11 +497,6 @@ let tag_var = tag Tag.variable pr (LevelLt lapp) a ++ prlist (fun a -> spc () ++ pr_expl_args pr a) l) - let pr_record_body_gen pr l = - spc () ++ - prlist_with_sep pr_semicolon - (fun (id, c) -> h 1 (pr_reference id ++ spc () ++ str":=" ++ pr ltop c)) l - let pr_forall n = keyword "forall" ++ pr_com_at n ++ spc () let pr_fun n = keyword "fun" ++ pr_com_at n ++ spc () @@ -568,10 +596,7 @@ let tag_var = tag Tag.variable | CApp ((None,a),l) -> return (pr_app (pr mt) a l, lapp) | CRecord l -> - return ( - hv 0 (str"{|" ++ pr_record_body_gen (pr spc) l ++ str" |}"), - latom - ) + return (pr_record_body "{|" "|}" (pr spc ltop) l, latom) | CCases (Constr.LetPatternStyle,rtntypopt,[c,as_clause,in_clause],[{v=([[p]],b)}]) -> return ( hv 0 ( @@ -717,7 +742,5 @@ let tag_var = tag Tag.variable let pr_cases_pattern_expr = pr_patt ltop - let pr_record_body = pr_record_body_gen pr - let pr_binders env sigma = pr_undelimited_binders spc (pr_expr env sigma ltop) diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli index 2850e4bfa0..02e04573f8 100644 --- a/printing/ppconstr.mli +++ b/printing/ppconstr.mli @@ -41,7 +41,8 @@ val pr_guard_annot -> recursion_order_expr option -> Pp.t -val pr_record_body : (qualid * constr_expr) list -> Pp.t +val pr_record : string -> string -> ('a -> Pp.t) -> 'a list -> Pp.t +val pr_record_body : string -> string -> ('a -> Pp.t) -> (Libnames.qualid * 'a) list -> Pp.t val pr_binders : Environ.env -> Evd.evar_map -> local_binder_expr list -> Pp.t val pr_constr_pattern_expr : Environ.env -> Evd.evar_map -> constr_pattern_expr -> Pp.t val pr_lconstr_pattern_expr : Environ.env -> Evd.evar_map -> constr_pattern_expr -> Pp.t diff --git a/printing/printer.ml b/printing/printer.ml index a1a2d9ae51..bc26caefbe 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -765,9 +765,9 @@ let pr_subgoals ?(pr_first=true) ?(diffs=false) ?os_map v 0 ( int ngoals ++ focused_if_needed ++ str(String.plural ngoals "subgoal") ++ print_extra - ++ str (if (should_gname()) then ", subgoal 1" else "") - ++ (if should_tag() then pr_goal_tag g1 else str"") - ++ pr_goal_name sigma g1 ++ cut () ++ goals + ++ str (if pr_first && (should_gname()) && ngoals > 1 then ", subgoal 1" else "") + ++ (if pr_first && should_tag() then pr_goal_tag g1 else str"") + ++ (if pr_first then pr_goal_name sigma g1 else mt()) ++ cut () ++ goals ++ (if unfocused=[] then str "" else (cut() ++ cut() ++ str "*** Unfocused goals:" ++ cut() ++ pr_rec (List.length rest + 2) unfocused)) diff --git a/printing/proof_diffs.ml b/printing/proof_diffs.ml index 43f70dfecc..b2ebc61b4e 100644 --- a/printing/proof_diffs.ml +++ b/printing/proof_diffs.ml @@ -252,6 +252,9 @@ let pp_of_type env sigma ty = let pr_leconstr_env ?lax ?inctx ?scope env sigma t = Ppconstr.pr_lconstr_expr env sigma (Constrextern.extern_constr ?lax ?inctx ?scope env sigma t) +let pr_econstr_env ?lax ?inctx ?scope env sigma t = + Ppconstr.pr_constr_expr env sigma (Constrextern.extern_constr ?lax ?inctx ?scope env sigma t) + let pr_lconstr_env ?lax ?inctx ?scope env sigma c = pr_leconstr_env ?lax ?inctx ?scope env sigma (EConstr.of_constr c) @@ -511,12 +514,12 @@ let match_goals ot nt = | CHole (k,naming,solve), CHole (k2,naming2,solve2) -> () | CPatVar _, CPatVar _ -> () | CEvar (n,l), CEvar (n2,l2) -> - let oevar = if ogname = "" then Id.to_string n else ogname in - nevar_to_oevar := CString.Map.add (Id.to_string n2) oevar !nevar_to_oevar; + let oevar = if ogname = "" then Id.to_string n.CAst.v else ogname in + nevar_to_oevar := CString.Map.add (Id.to_string n2.CAst.v) oevar !nevar_to_oevar; iter2 (fun x x2 -> let (_, g) = x and (_, g2) = x2 in constr_expr ogname g g2) l l2 | CEvar (n,l), nt' -> (* pass down the old goal evar name *) - match_goals_r (Id.to_string n) nt' nt' + match_goals_r (Id.to_string n.CAst.v) nt' nt' | CSort s, CSort s2 -> () | CCast (c,c'), CCast (c2,c'2) -> constr_expr ogname c c2; @@ -660,3 +663,22 @@ let make_goal_map op np = let ng_to_og = make_goal_map_i op np in (*db_goal_map op np ng_to_og;*) ng_to_og + +let diff_proofs ~diff_opt ?old proof = + let pp_proof p = + let sigma, env = Proof.get_proof_context p in + let pprf = Proof.partial_proof p in + Pp.prlist_with_sep Pp.fnl (pr_econstr_env env sigma) pprf in + match diff_opt with + | DiffOff -> pp_proof proof + | _ -> begin + try + let n_pp = pp_proof proof in + let o_pp = match old with + | None -> Pp.mt() + | Some old -> pp_proof old in + let show_removed = Some (diff_opt = DiffRemoved) in + Pp_diff.diff_pp_combined ~tokenize_string ?show_removed o_pp n_pp + with + | Pp_diff.Diff_Failure msg -> Pp.str msg + end diff --git a/printing/proof_diffs.mli b/printing/proof_diffs.mli index ea64439456..6bdd7004fb 100644 --- a/printing/proof_diffs.mli +++ b/printing/proof_diffs.mli @@ -25,6 +25,10 @@ val write_color_enabled : bool -> unit (** true indicates that color output is enabled *) val color_enabled : unit -> bool +type diffOpt = DiffOff | DiffOn | DiffRemoved + +val string_to_diffs : string -> diffOpt + open Evd open Environ open Constr @@ -84,3 +88,5 @@ type hyp_info = { } val diff_hyps : string list list -> hyp_info CString.Map.t -> string list list -> hyp_info CString.Map.t -> Pp.t list + +val diff_proofs : diff_opt:diffOpt -> ?old:Proof.t -> Proof.t -> Pp.t diff --git a/proofs/clenv.ml b/proofs/clenv.ml index 31bc698830..387f0f6f5f 100644 --- a/proofs/clenv.ml +++ b/proofs/clenv.ml @@ -720,7 +720,7 @@ let make_clenv_binding env sigma = make_clenv_binding_gen false None env sigma (* Pretty-print *) let pr_clenv clenv = - h 0 + h (str"TEMPL: " ++ Termops.Internal.print_constr_env clenv.env clenv.evd clenv.templval.rebus ++ str" : " ++ Termops.Internal.print_constr_env clenv.env clenv.evd clenv.templtyp.rebus ++ fnl () ++ pr_evar_map (Some 2) clenv.env clenv.evd) diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml index a8088dae36..4f04b9fe1c 100644 --- a/stm/asyncTaskQueue.ml +++ b/stm/asyncTaskQueue.ml @@ -386,3 +386,8 @@ end module MakeQueue(T : Task) () = struct include Make(T) () end module MakeWorker(T : Task) () = struct include Make(T) () end + +exception RemoteException of Pp.t +let _ = CErrors.register_handler (function + | RemoteException ppcmd -> Some ppcmd + | _ -> None) diff --git a/stm/asyncTaskQueue.mli b/stm/asyncTaskQueue.mli index cf174d0c93..a1fa6f7268 100644 --- a/stm/asyncTaskQueue.mli +++ b/stm/asyncTaskQueue.mli @@ -220,3 +220,6 @@ module MakeWorker(T : Task) () : sig val main_loop : unit -> unit end + +(** convenience exception to marshall to master *) +exception RemoteException of Pp.t diff --git a/stm/partac.ml b/stm/partac.ml new file mode 100644 index 0000000000..8232b017f9 --- /dev/null +++ b/stm/partac.ml @@ -0,0 +1,178 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \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 + +let stm_pr_err s = Format.eprintf "%s] %s\n%!" (Spawned.process_id ()) s + +module TacTask : sig + + type output = (Constr.constr * UState.t) option + type task = { + t_state : Vernacstate.t; + t_assign : output Future.assignment -> unit; + t_ast : ComTactic.interpretable; + t_goalno : int; + t_goal : Goal.goal; + t_kill : unit -> unit; + t_name : string } + + include AsyncTaskQueue.Task with type task := task + +end = struct (* {{{ *) + + let forward_feedback { Feedback.doc_id = did; span_id = id; route; contents } = + Feedback.feedback ~did ~id ~route contents + + type output = (Constr.constr * UState.t) option + + type task = { + t_state : Vernacstate.t; + t_assign : output Future.assignment -> unit; + t_ast : ComTactic.interpretable; + t_goalno : int; + t_goal : Goal.goal; + t_kill : unit -> unit; + t_name : string } + + type request = { + r_state : Vernacstate.t option; + r_ast : ComTactic.interpretable; + r_goalno : int; + r_goal : Goal.goal; + r_name : string } + + type response = + | RespBuiltSubProof of (Constr.constr * UState.t) + | RespError of Pp.t + | RespNoProgress + + let name = ref "tacticworker" + let extra_env () = [||] + type competence = unit + type worker_status = Fresh | Old of competence + + let task_match _ _ = true + + (* run by the master, on a thread *) + let request_of_task age { t_state; t_ast; t_goalno; t_goal; t_name } = + Some { + r_state = if age <> Fresh then None else Some t_state; + r_ast = t_ast; + r_goalno = t_goalno; + r_goal = t_goal; + r_name = t_name } + + let use_response _ { t_assign; t_kill } resp = + match resp with + | RespBuiltSubProof o -> t_assign (`Val (Some o)); `Stay ((),[]) + | RespNoProgress -> + t_assign (`Val None); + t_kill (); + `Stay ((),[]) + | RespError msg -> + let e = (AsyncTaskQueue.RemoteException msg, Exninfo.null) in + t_assign (`Exn e); + t_kill (); + `Stay ((),[]) + + let on_marshal_error err { t_name } = + stm_pr_err ("Fatal marshal error: " ^ t_name ); + flush_all (); exit 1 + + let on_task_cancellation_or_expiration_or_slave_death = function + | Some { t_kill } -> t_kill () + | _ -> () + + let command_focus = Proof.new_focus_kind () + let focus_cond = Proof.no_cond command_focus + + let state = ref None + let receive_state = function + | None -> () + | Some st -> state := Some st + + let perform { r_state = st; r_ast = tactic; r_goal; r_goalno } = + receive_state st; + Vernacstate.unfreeze_interp_state (Option.get !state); + try + Vernacstate.LemmaStack.with_top (Option.get (Option.get !state).Vernacstate.lemmas) ~f:(fun pstate -> + let pstate = + Declare.Proof.map pstate ~f:(Proof.focus focus_cond () r_goalno) in + let pstate = + ComTactic.solve ~pstate + Goal_select.SelectAll ~info:None tactic ~with_end_tac:false in + let { Proof.sigma } = Declare.Proof.fold pstate ~f:Proof.data in + match Evd.(evar_body (find sigma r_goal)) with + | Evd.Evar_empty -> RespNoProgress + | Evd.Evar_defined t -> + let t = Evarutil.nf_evar sigma t in + let evars = Evarutil.undefined_evars_of_term sigma t in + if Evar.Set.is_empty evars then + let t = EConstr.Unsafe.to_constr t in + RespBuiltSubProof (t, Evd.evar_universe_context sigma) + else + CErrors.user_err ~hdr:"STM" + Pp.(str"The par: selector requires a tactic that makes no progress or fully" ++ + str" solves the goal and leaves no unresolved existential variables. The following" ++ + str" existentials remain unsolved: " ++ prlist (Termops.pr_existential_key sigma) (Evar.Set.elements evars)) + ) + with e when CErrors.noncritical e -> + RespError (CErrors.print e ++ spc() ++ str "(for subgoal "++int r_goalno ++ str ")") + + let name_of_task { t_name } = t_name + let name_of_request { r_name } = r_name + +end (* }}} *) + +module TaskQueue = AsyncTaskQueue.MakeQueue(TacTask) () + +let assign_tac ~abstract res : unit Proofview.tactic = + Proofview.(Goal.enter begin fun g -> + let gid = Goal.goal g in + let g_solution = + try List.assoc gid res + with Not_found -> CErrors.anomaly(str"Partac: wrong focus.") in + if not (Future.is_over g_solution) then + tclUNIT () + else + let open Notations in + match Future.join g_solution with + | Some (pt, uc) -> + let push_state ctx = + Proofview.tclEVARMAP >>= fun sigma -> + Proofview.Unsafe.tclEVARS (Evd.merge_universe_context sigma ctx) + in + (if abstract then Abstract.tclABSTRACT None else (fun x -> x)) + (push_state uc <*> Tactics.exact_no_check (EConstr.of_constr pt)) + | None -> tclUNIT () + end) + +let enable_par ~nworkers = ComTactic.set_par_implementation + (fun ~pstate ~info t_ast ~abstract ~with_end_tac -> + let t_state = Vernacstate.freeze_interp_state ~marshallable:true in + TaskQueue.with_n_workers nworkers CoqworkmgrApi.High (fun queue -> + Declare.Proof.map pstate ~f:(fun p -> + let open TacTask in + let results = (Proof.data p).Proof.goals |> CList.map_i (fun i g -> + let g_solution, t_assign = + Future.create_delegate ~name:(Printf.sprintf "subgoal %d" i) + (fun x -> x) in + TaskQueue.enqueue_task queue + ~cancel_switch:(ref false) + { t_state; t_assign; t_ast; + t_goalno = i; t_goal = g; t_name = Goal.uid g; + t_kill = (fun () -> TaskQueue.cancel_all queue) }; + g, g_solution) 1 in + TaskQueue.join queue; + let p,_,() = + Proof.run_tactic (Global.env()) + (assign_tac ~abstract results) p in + p))) diff --git a/stm/partac.mli b/stm/partac.mli new file mode 100644 index 0000000000..a206b2e5d8 --- /dev/null +++ b/stm/partac.mli @@ -0,0 +1,13 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \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) *) +(************************************************************************) + +val enable_par : nworkers:int -> unit + +module TacTask : AsyncTaskQueue.Task diff --git a/stm/stm.ml b/stm/stm.ml index 4ca0c365bf..85f889c879 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -159,9 +159,9 @@ type cmd_t = { cids : Names.Id.t list; cblock : proof_block_name option; cqueue : [ `MainQueue - | `TacQueue of solving_tac * anon_abstracting_tac * AsyncTaskQueue.cancel_switch - | `QueryQueue of AsyncTaskQueue.cancel_switch - | `SkipQueue ] } + | `QueryQueue + | `SkipQueue ]; + cancel_switch : AsyncTaskQueue.cancel_switch; } type fork_t = aast * Vcs_.Branch.t * opacity_guarantee * Names.Id.t list type qed_t = { qast : aast; @@ -190,10 +190,10 @@ type step = type visit = { step : step; next : Stateid.t } let mkTransTac cast cblock cqueue = - Cmd { ctac = true; cast; cblock; cqueue; cids = []; ceff = false } + Cmd { ctac = true; cast; cblock; cqueue; cids = []; ceff = false; cancel_switch = ref false } let mkTransCmd cast cids ceff cqueue = - Cmd { ctac = false; cast; cblock = None; cqueue; cids; ceff } + Cmd { ctac = false; cast; cblock = None; cqueue; cids; ceff; cancel_switch = ref false } type cached_state = | EmptyState @@ -742,8 +742,7 @@ end = struct (* {{{ *) Stateid.Set.iter (fun id -> match (Vcs_aux.visit old_vcs id).step with | `Qed ({ fproof = Some (_, cancel_switch) }, _) - | `Cmd { cqueue = `TacQueue (_,_,cancel_switch) } - | `Cmd { cqueue = `QueryQueue cancel_switch } -> + | `Cmd { cancel_switch } -> cancel_switch := true | _ -> ()) erased_nodes; @@ -1222,11 +1221,6 @@ let record_pb_time ?loc proof_name time = hints := Aux_file.set !hints proof_name proof_build_time end -exception RemoteException of Pp.t -let _ = CErrors.register_handler (function - | RemoteException ppcmd -> Some ppcmd - | _ -> None) - (****************** proof structure for error recovery ************************) (******************************************************************************) @@ -1429,7 +1423,7 @@ end = struct (* {{{ *) RespError { e_error_at; e_safe_id = valid; e_msg; e_safe_states } -> feedback (InProgress ~-1); let info = Stateid.add ~valid Exninfo.null e_error_at in - let e = (RemoteException e_msg, info) in + let e = (AsyncTaskQueue.RemoteException e_msg, info) in t_assign (`Exn e); `Stay(t_states,[States e_safe_states]) | _ -> assert false @@ -1440,7 +1434,7 @@ end = struct (* {{{ *) | Some (BuildProof { t_start = start; t_assign }) -> let s = "Worker dies or task expired" in let info = Stateid.add ~valid:start Exninfo.null start in - let e = (RemoteException (Pp.strbrk s), info) in + let e = (AsyncTaskQueue.RemoteException (Pp.strbrk s), info) in t_assign (`Exn e); execution_error start (Pp.strbrk s); feedback (InProgress ~-1) @@ -1792,225 +1786,6 @@ end = struct (* {{{ *) end (* }}} *) -and TacTask : sig - - type output = (Constr.constr * UState.t) option - type task = { - t_state : Stateid.t; - t_state_fb : Stateid.t; - t_assign : output Future.assignment -> unit; - t_ast : int * aast; - t_goal : Goal.goal; - t_kill : unit -> unit; - t_name : string } - - include AsyncTaskQueue.Task with type task := task - -end = struct (* {{{ *) - - type output = (Constr.constr * UState.t) option - - let forward_feedback msg = Hooks.(call forward_feedback msg) - - type task = { - t_state : Stateid.t; - t_state_fb : Stateid.t; - t_assign : output Future.assignment -> unit; - t_ast : int * aast; - t_goal : Goal.goal; - t_kill : unit -> unit; - t_name : string } - - type request = { - r_state : Stateid.t; - r_state_fb : Stateid.t; - r_document : VCS.vcs option; - r_ast : int * aast; - r_goal : Goal.goal; - r_name : string } - - type response = - | RespBuiltSubProof of (Constr.constr * UState.t) - | RespError of Pp.t - | RespNoProgress - - let name = ref "tacticworker" - let extra_env () = [||] - type competence = unit - type worker_status = Fresh | Old of competence - - let task_match _ _ = true - - (* run by the master, on a thread *) - let request_of_task age { t_state; t_state_fb; t_ast; t_goal; t_name } = - try Some { - r_state = t_state; - r_state_fb = t_state_fb; - r_document = - if age <> Fresh then None - else Some (VCS.slice ~block_start:t_state ~block_stop:t_state); - r_ast = t_ast; - r_goal = t_goal; - r_name = t_name } - with VCS.Expired -> None - - let use_response _ { t_assign; t_state; t_state_fb; t_kill } resp = - match resp with - | RespBuiltSubProof o -> t_assign (`Val (Some o)); `Stay ((),[]) - | RespNoProgress -> - t_assign (`Val None); - t_kill (); - `Stay ((),[]) - | RespError msg -> - let e = (RemoteException msg, Exninfo.null) in - t_assign (`Exn e); - t_kill (); - `Stay ((),[]) - - let on_marshal_error err { t_name } = - stm_pr_err ("Fatal marshal error: " ^ t_name ); - flush_all (); exit 1 - - let on_task_cancellation_or_expiration_or_slave_death = function - | Some { t_kill } -> t_kill () - | _ -> () - - let command_focus = Proof.new_focus_kind () - let focus_cond = Proof.no_cond command_focus - - let perform { r_state = id; r_state_fb; r_document = vcs; r_ast; r_goal } = - Option.iter VCS.restore vcs; - try - Reach.known_state ~doc:dummy_doc (* XXX should be vcs *) ~cache:false id; - State.purify (fun () -> - let Proof.{sigma=sigma0} = Proof.data (PG_compat.give_me_the_proof ()) in - let g = Evd.find sigma0 r_goal in - let is_ground c = Evarutil.is_ground_term sigma0 c in - if not ( - is_ground Evd.(evar_concl g) && - List.for_all (Context.Named.Declaration.for_all is_ground) - Evd.(evar_context g)) - then - CErrors.user_err ~hdr:"STM" Pp.(strbrk("The par: goal selector does not support goals with existential variables")) - else begin - let (i, ast) = r_ast in - PG_compat.map_proof (fun p -> Proof.focus focus_cond () i p); - (* STATE SPEC: - * - start : id - * - return: id - * => captures state id in a future closure, which will - discard execution state but for the proof + univs. - *) - let st = Vernacstate.freeze_interp_state ~marshallable:false in - ignore(stm_vernac_interp r_state_fb st ast); - let Proof.{sigma} = Proof.data (PG_compat.give_me_the_proof ()) in - match Evd.(evar_body (find sigma r_goal)) with - | Evd.Evar_empty -> RespNoProgress - | Evd.Evar_defined t -> - let t = Evarutil.nf_evar sigma t in - let evars = Evarutil.undefined_evars_of_term sigma t in - if Evar.Set.is_empty evars then - let t = EConstr.Unsafe.to_constr t in - RespBuiltSubProof (t, Evd.evar_universe_context sigma) - else - CErrors.user_err ~hdr:"STM" - Pp.(str"The par: selector requires a tactic that makes no progress or fully" ++ - str" solves the goal and leaves no unresolved existential variables. The following" ++ - str" existentials remain unsolved: " ++ prlist (Termops.pr_existential_key sigma) (Evar.Set.elements evars)) - end) () - with e when CErrors.noncritical e -> - RespError (CErrors.print e ++ spc() ++ str "(for subgoal "++int (fst r_ast) ++ str ")") - - let name_of_task { t_name } = t_name - let name_of_request { r_name } = r_name - -end (* }}} *) - -and Partac : sig - - val vernac_interp : - solve:bool -> abstract:bool -> cancel_switch:AsyncTaskQueue.cancel_switch -> - int -> CoqworkmgrApi.priority -> Stateid.t -> Stateid.t -> aast -> unit - -end = struct (* {{{ *) - - module TaskQueue = AsyncTaskQueue.MakeQueue(TacTask) () - - let stm_fail ~st fail f = - if fail then - Vernacinterp.with_fail ~st f - else - f () - - let vernac_interp ~solve ~abstract ~cancel_switch nworkers priority safe_id id - { indentation; verbose; expr = e; strlen } : unit - = - let cl, time, batch, fail = - let rec find ~time ~batch ~fail cl = match cl with - | ControlTime batch :: cl -> find ~time:true ~batch ~fail cl - | ControlRedirect _ :: cl -> find ~time ~batch ~fail cl - | ControlFail :: cl -> find ~time ~batch ~fail:true cl - | cl -> cl, time, batch, fail in - find ~time:false ~batch:false ~fail:false e.CAst.v.control in - let e = CAst.map (fun cmd -> { cmd with control = cl }) e in - let st = Vernacstate.freeze_interp_state ~marshallable:false in - stm_fail ~st fail (fun () -> - (if time then System.with_time ~batch ~header:(Pp.mt ()) else (fun x -> x)) (fun () -> - TaskQueue.with_n_workers nworkers priority (fun queue -> - PG_compat.map_proof (fun p -> - let Proof.{goals} = Proof.data p in - let open TacTask in - let res = CList.map_i (fun i g -> - let f, assign = - Future.create_delegate - ~name:(Printf.sprintf "subgoal %d" i) - (State.exn_on id ~valid:safe_id) in - let t_ast = (i, { indentation; verbose; expr = e; strlen }) in - let t_name = Goal.uid g in - TaskQueue.enqueue_task queue - { t_state = safe_id; t_state_fb = id; - t_assign = assign; t_ast; t_goal = g; t_name; - t_kill = (fun () -> if solve then TaskQueue.cancel_all queue) } - ~cancel_switch; - g,f) - 1 goals in - TaskQueue.join queue; - let assign_tac : unit Proofview.tactic = - Proofview.(Goal.enter begin fun g -> - let gid = Goal.goal g in - let f = - try List.assoc gid res - with Not_found -> CErrors.anomaly(str"Partac: wrong focus.") in - if not (Future.is_over f) then - (* One has failed and cancelled the others, but not this one *) - if solve then Tacticals.New.tclZEROMSG - (str"Interrupted by the failure of another goal") - else tclUNIT () - else - let open Notations in - match Future.join f with - | Some (pt, uc) -> - let sigma, env = PG_compat.get_current_context () in - let push_state ctx = - Proofview.tclEVARMAP >>= fun sigma -> - Proofview.Unsafe.tclEVARS (Evd.merge_universe_context sigma ctx) - in - stm_pperr_endline (fun () -> hov 0 ( - str"g=" ++ int (Evar.repr gid) ++ spc () ++ - str"t=" ++ (Printer.pr_constr_env env sigma pt) ++ spc () ++ - str"uc=" ++ Termops.pr_evar_universe_context uc)); - (if abstract then Abstract.tclABSTRACT None else (fun x -> x)) - (push_state uc <*> - Tactics.exact_no_check (EConstr.of_constr pt)) - | None -> - if solve then Tacticals.New.tclSOLVE [] else tclUNIT () - end) - in - let p,_,() = Proof.run_tactic (Global.env()) assign_tac p in - p))) ()) - -end (* }}} *) - and QueryTask : sig type task = { t_where : Stateid.t; t_for : Stateid.t ; t_what : aast } @@ -2361,15 +2136,7 @@ let known_state ~doc ?(redefine_qed=false) ~cache id = ), cache, true | `Cmd { cast = x; cqueue = `SkipQueue } -> (fun () -> reach view.next), cache, true - | `Cmd { cast = x; cqueue = `TacQueue (solve,abstract,cancel_switch); cblock } -> - (fun () -> - resilient_tactic id cblock (fun () -> - reach ~cache:true view.next; - Partac.vernac_interp ~solve ~abstract ~cancel_switch - !cur_opt.async_proofs_n_tacworkers - !cur_opt.async_proofs_worker_priority view.next id x) - ), cache, true - | `Cmd { cast = x; cqueue = `QueryQueue cancel_switch } + | `Cmd { cast = x; cqueue = `QueryQueue; cancel_switch } when async_proofs_is_master !cur_opt -> (fun () -> reach view.next; Query.vernac_interp ~cancel_switch view.next id x @@ -2377,7 +2144,6 @@ let known_state ~doc ?(redefine_qed=false) ~cache id = | `Cmd { cast = x; ceff = eff; ctac = true; cblock } -> (fun () -> resilient_tactic id cblock (fun () -> reach view.next; - (* State resulting from reach *) let st = Vernacstate.freeze_interp_state ~marshallable:false in ignore(stm_vernac_interp id st x) ) @@ -2588,6 +2354,7 @@ let doc_type_module_name (std : stm_doc_type) = let init_core () = if !cur_opt.async_proofs_mode = APon then Control.enable_thread_delay := true; + if !Flags.async_proofs_worker_id = "master" then Partac.enable_par ~nworkers:!cur_opt.async_proofs_n_tacworkers; State.register_root_state () let dirpath_of_file f = @@ -2938,12 +2705,9 @@ let process_transaction ~doc ?(newtip=Stateid.fresh ()) VCS.set_parsing_state id head_parsing; Backtrack.record (); `Ok - | VtProofStep { parallel; proof_block_detection = cblock } -> + | VtProofStep { proof_block_detection = cblock } -> let id = VCS.new_node ~id:newtip proof_mode () in - let queue = - match parallel with - | `Yes(solve,abstract) -> `TacQueue (solve, abstract, ref false) - | `No -> `MainQueue in + let queue = `MainQueue in VCS.commit id (mkTransTac x cblock queue); (* Static proof block detection delayed until an error really occurs. If/when and UI will make something useful with this piece of info, diff --git a/stm/stm.mli b/stm/stm.mli index 9780c96512..097bcbe0ca 100644 --- a/stm/stm.mli +++ b/stm/stm.mli @@ -195,7 +195,6 @@ val set_perspective : doc:doc -> Stateid.t list -> unit (** workers **************************************************************** **) module ProofTask : AsyncTaskQueue.Task -module TacTask : AsyncTaskQueue.Task module QueryTask : AsyncTaskQueue.Task (** document structure customization *************************************** **) diff --git a/stm/stm.mllib b/stm/stm.mllib index 4b254e8113..831369625f 100644 --- a/stm/stm.mllib +++ b/stm/stm.mllib @@ -6,6 +6,7 @@ WorkerPool Vernac_classifier CoqworkmgrApi AsyncTaskQueue +Partac Stm ProofBlockDelimiter Vio_checking diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml index f89fb9f52d..ffae2866c0 100644 --- a/stm/vernac_classifier.ml +++ b/stm/vernac_classifier.ml @@ -15,11 +15,6 @@ open CAst open Vernacextend open Vernacexpr -let string_of_parallel = function - | `Yes (solve,abs) -> - "par" ^ if solve then "solve" else "" ^ if abs then "abs" else "" - | `No -> "" - let string_of_vernac_when = function | VtLater -> "Later" | VtNow -> "Now" @@ -30,9 +25,8 @@ let string_of_vernac_classification = function | VtQed (VtKeep VtKeepAxiom) -> "Qed(admitted)" | VtQed (VtKeep (VtKeepOpaque | VtKeepDefined)) -> "Qed(keep)" | VtQed VtDrop -> "Qed(drop)" - | VtProofStep { parallel; proof_block_detection } -> - "ProofStep " ^ string_of_parallel parallel ^ - Option.default "" proof_block_detection + | VtProofStep { proof_block_detection } -> + "ProofStep " ^ Option.default "" proof_block_detection | VtQuery -> "Query" | VtMeta -> "Meta " | VtProofMode _ -> "Proof Mode" @@ -80,12 +74,11 @@ let classify_vernac e = | VernacCheckGuard | VernacUnfocused | VernacSolveExistential _ -> - VtProofStep { parallel = `No; proof_block_detection = None } + VtProofStep { proof_block_detection = None } | VernacBullet _ -> - VtProofStep { parallel = `No; proof_block_detection = Some "bullet" } + VtProofStep { proof_block_detection = Some "bullet" } | VernacEndSubproof -> - VtProofStep { parallel = `No; - proof_block_detection = Some "curly" } + VtProofStep { proof_block_detection = Some "curly" } (* StartProof *) | VernacDefinition ((DoDischarge,_),({v=i},_),ProveBody _) -> VtStartProof(Doesn'tGuaranteeOpacity, idents_of_name i) @@ -135,7 +128,7 @@ let classify_vernac e = | Constructors l -> List.map (fun (_,({v=id},_)) -> id) l | RecordDecl (oid,l) -> (match oid with Some {v=x} -> [x] | _ -> []) @ CList.map_filter (function - | AssumExpr({v=Names.Name n},_), _ -> Some n + | AssumExpr({v=Names.Name n},_,_), _ -> Some n | _ -> None) l) l in VtSideff (List.flatten ids, VtLater) | VernacScheme l -> @@ -213,7 +206,7 @@ let classify_vernac e = (match static_classifier ~atts:v.attrs v.expr with | VtQuery | VtProofStep _ | VtSideff _ | VtMeta as x -> x - | VtQed _ -> VtProofStep { parallel = `No; proof_block_detection = None } + | VtQed _ -> VtProofStep { proof_block_detection = None } | VtStartProof _ | VtProofMode _ -> VtQuery) else static_classifier ~atts:v.attrs v.expr diff --git a/tactics/cbn.ml b/tactics/cbn.ml index 8f0966a486..0b13f4763a 100644 --- a/tactics/cbn.ml +++ b/tactics/cbn.ml @@ -543,7 +543,7 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma = let open Pp in let pr c = Termops.Internal.print_constr_env env sigma c in Feedback.msg_debug - (h 0 (str "<<" ++ pr x ++ + (h (str "<<" ++ pr x ++ str "|" ++ cut () ++ Cst_stack.pr env sigma cst_l ++ str "|" ++ cut () ++ Stack.pr pr stack ++ str ">>")) diff --git a/test-suite/bugs/closed/bug_12414.v b/test-suite/bugs/closed/bug_12414.v new file mode 100644 index 0000000000..50b4b86eff --- /dev/null +++ b/test-suite/bugs/closed/bug_12414.v @@ -0,0 +1,13 @@ +Set Universe Polymorphism. +Set Printing Universes. +Inductive list {T} : Type := | cons (t : T) : list -> list. (* who needs nil anyway? *) +Arguments list : clear implicits. + +Fixpoint map {A B} (f: A -> B) (l : list A) : list B := + let '(cons t l) := l in cons (f t) (map f l). +About map@{_ _}. +(* Two universes, as expected. *) + +Definition map_Set@{} {A B : Set} := @map A B. + +Definition map_Prop@{} {A B : Prop} := @map A B. diff --git a/test-suite/bugs/closed/bug_12623.v b/test-suite/bugs/closed/bug_12623.v new file mode 100644 index 0000000000..9fdcb94e0c --- /dev/null +++ b/test-suite/bugs/closed/bug_12623.v @@ -0,0 +1,18 @@ +Set Universe Polymorphism. + +Axiom M : Type -> Prop. +Axiom raise : forall {T}, M T. + +Inductive goal : Type := +| AHyp : forall {A : Type}, goal. + +Definition gtactic@{u u0} := goal@{u} -> M@{u0} (False). + +Class Seq (C : Type) := + seq : C -> gtactic. +Arguments seq {C _} _. + +Instance seq_one : Seq@{Set _ _} (gtactic) := fun t2 => fun g => raise. + +Definition x1 : gtactic := @seq@{_ _ _} _ _ (fun g : goal => raise). +Definition x2 : gtactic := @seq@{_ _ _} _ seq_one (fun g : goal => raise). diff --git a/test-suite/bugs/closed/bug_12895.v b/test-suite/bugs/closed/bug_12895.v new file mode 100644 index 0000000000..53adc2981c --- /dev/null +++ b/test-suite/bugs/closed/bug_12895.v @@ -0,0 +1,20 @@ +Fixpoint bug_1 (e1 : nat) {struct e1} + : nat +with bug_2 {H_imp : nat} (e2 : nat) {struct e2} + : nat. +Proof. + - exact e1. + - exact e2. +Admitted. + +Fixpoint hbug_1 (a:bool) (e1 : nat) {struct e1} + : nat +with hbug_2 (a:nat) (e2 : nat) {struct e2} + : nat. +Proof. + - exact e1. + - exact e2. +Admitted. + +Check (hbug_1 : bool -> nat -> nat). +Check (hbug_2 : nat -> nat -> nat). diff --git a/test-suite/bugs/closed/bug_12917.v b/test-suite/bugs/closed/bug_12917.v new file mode 100644 index 0000000000..cd6b0766c6 --- /dev/null +++ b/test-suite/bugs/closed/bug_12917.v @@ -0,0 +1 @@ +Fail Derive Inversion bla with (le _ _). diff --git a/test-suite/bugs/closed/bug_12947.v b/test-suite/bugs/closed/bug_12947.v new file mode 100644 index 0000000000..baf0579465 --- /dev/null +++ b/test-suite/bugs/closed/bug_12947.v @@ -0,0 +1,9 @@ +Require Import BinPos Int63 PArray. + +Definition foo (n : positive) := + let a := make 2 0 in + let b := Pos.iter (fun b => set b 1 1) a 100000 in + let v := get b 0 in + Pos.iter (fun v => v + get a 0) v n. + +Timeout 5 Time Eval vm_compute in foo 1000000. diff --git a/test-suite/bugs/closed/bug_12970.v b/test-suite/bugs/closed/bug_12970.v new file mode 100644 index 0000000000..69ce7ec2c2 --- /dev/null +++ b/test-suite/bugs/closed/bug_12970.v @@ -0,0 +1,4 @@ +Arguments existT _ & _ _. + +Definition f := fun X (A : X -> Type) (P : forall x, A x -> Type) x y => + existT (fun f => forall x, P x (f x)) x y : sigT (fun f => forall x, P x (f x)). diff --git a/test-suite/bugs/closed/bug_13086.v b/test-suite/bugs/closed/bug_13086.v new file mode 100644 index 0000000000..75f842b1cf --- /dev/null +++ b/test-suite/bugs/closed/bug_13086.v @@ -0,0 +1,11 @@ +Unset Universe Checking. + +Definition bad1@{|Set < Set} := Prop. + +Set Universe Polymorphism. +Axiom ax : Type. +Inductive I@{u} : Prop := foo : ax@{u} -> I. + +Definition bad2@{v} (x:I@{v}) : I@{Set} := x. + +Definition vsdvds (f : (Prop -> Prop) -> Prop) (x : Set -> Prop) := f x. diff --git a/test-suite/bugs/closed/bug_13117.v b/test-suite/bugs/closed/bug_13117.v new file mode 100644 index 0000000000..5db3f9fadc --- /dev/null +++ b/test-suite/bugs/closed/bug_13117.v @@ -0,0 +1,23 @@ + +Class A := {}. + +Class B (x:A) := {}. +Class B' (a:=A) (x:a) := {}. + +Fail Definition foo a `{B a} := 0. +Definition foo a `{B' a} := 0. + +Record C (x:A) := {}. +Existing Class C. + +Fail Definition bar a `{C a} := 0. + + +Definition X := Type. + +Class Y (x:X) := {}. + +Definition before `{Y Set} := 0. + +Existing Class X. +Fail Definition after `{Y Set} := 0. diff --git a/test-suite/bugs/closed/bug_13129.v b/test-suite/bugs/closed/bug_13129.v new file mode 100644 index 0000000000..632605ecc7 --- /dev/null +++ b/test-suite/bugs/closed/bug_13129.v @@ -0,0 +1,58 @@ +From Coq Require Export Morphisms Setoid . + +Class Equiv A := equiv: relation A. + +Infix "≡" := equiv (at level 70, no associativity). +Infix "≡@{ A }" := (@equiv A _) + (at level 70, only parsing, no associativity). + +Notation "(≡)" := equiv (only parsing). + +(** Unbundled version *) +Class Dist A := dist : nat -> relation A. + +Notation "x ≡{ n }≡ y" := (dist n x y) + (at level 70, n at next level, format "x ≡{ n }≡ y"). +Notation "x ≡{ n }@{ A }≡ y" := (dist (A:=A) n x y) + (at level 70, n at next level, only parsing). + +Notation NonExpansive f := (forall n, Proper (dist n ==> dist n ==> dist n) f). + +Record OfeMixin A `{Equiv A, Dist A} := { + mixin_equiv_dist (x y : A) : x ≡ y <-> forall n, x ≡{n}≡ y; +}. + +(** Bundled version *) +Structure ofeT := OfeT { + ofe_car :> Type; + ofe_equiv : Equiv ofe_car; + ofe_dist : Dist ofe_car; + ofe_mixin : OfeMixin ofe_car +}. +Hint Extern 0 (Equiv _) => eapply (@ofe_equiv _) : typeclass_instances. +Hint Extern 0 (Dist _) => eapply (@ofe_dist _) : typeclass_instances. + +(** Lifting properties from the mixin *) +Section ofe_mixin. + Context {A : ofeT}. + Implicit Types x y : A. + Lemma equiv_dist x y : x ≡ y <-> forall n, x ≡{n}≡ y. + Proof. apply (mixin_equiv_dist _ (ofe_mixin A)). Qed. +End ofe_mixin. + +Axiom _0 : Prop. (* dummy which somehow bothers mangle names *) +Set Mangle Names. + +(** General properties *) +Section ofe. + Context {A : ofeT}. + + Lemma ne_proper_2 {B C : ofeT} (f : A -> B -> C) `{Hf:!NonExpansive f} : + Proper ((≡) ==> (≡) ==> (≡)) f. + Proof. + unfold Proper, respectful. + setoid_rewrite equiv_dist. + intros. + apply Hf;auto. + Qed. +End ofe. diff --git a/test-suite/bugs/closed/bug_13169.v b/test-suite/bugs/closed/bug_13169.v new file mode 100644 index 0000000000..a0b564c725 --- /dev/null +++ b/test-suite/bugs/closed/bug_13169.v @@ -0,0 +1,14 @@ +Goal False. +Proof. + set (H1:=I). + set (x:=true). + assert (H2: x = true) by reflexivity. + set (y:=false). + assert (H3: y = false) by reflexivity. + clearbody H1 x y. + eenough (H4: _ = false). + vm_compute in H4. + (* H4 now has "x:=y" in the evar context. *) + 2: exact H3. + match type of H4 with y = false => idtac end. +Abort. diff --git a/test-suite/bugs/closed/bug_13171.v b/test-suite/bugs/closed/bug_13171.v new file mode 100644 index 0000000000..0564722729 --- /dev/null +++ b/test-suite/bugs/closed/bug_13171.v @@ -0,0 +1,10 @@ +Primitive array := #array_type. + +Goal False. +Proof. + unshelve epose (_:nat). exact_no_check true. + Fail let c := open_constr:([| n | 0 |]) in + let c := eval cbv in c in + let c := type of c in + idtac c. +Abort. diff --git a/test-suite/bugs/closed/bug_5197.v b/test-suite/bugs/closed/bug_5197.v index 0c236e12ad..00b9e9bd9d 100644 --- a/test-suite/bugs/closed/bug_5197.v +++ b/test-suite/bugs/closed/bug_5197.v @@ -20,11 +20,11 @@ Definition Typeᶠ : TYPE := {| rel := fun _ A => (forall ω : Ω, A ω) -> Type; |}. Set Printing Universes. -Fail Definition Typeᵇ : El Typeᶠ := +Definition Typeᵇ : El Typeᶠ := mkPack _ _ (fun w => Type) (fun w A => (forall ω, A ω) -> Type). -Definition Typeᵇ : El Typeᶠ := - mkPack _ (fun _ (A : Ω -> Type) => (forall ω : Ω, A ω) -> _) (fun w => Type) (fun w A => (forall ω, A ω) -> Type). +(* Definition Typeᵇ : El Typeᶠ := *) +(* mkPack _ (fun _ (A : Ω -> Type) => (forall ω : Ω, A ω) -> _) (fun w => Type) (fun w A => (forall ω, A ω) -> Type). *) (** Bidirectional typechecking helps here *) Require Import Program.Tactics. diff --git a/test-suite/ide/proof-diffs.fake b/test-suite/ide/proof-diffs.fake new file mode 100644 index 0000000000..594ebced23 --- /dev/null +++ b/test-suite/ide/proof-diffs.fake @@ -0,0 +1,10 @@ +ADD { Goal True /\ False /\ True = False. } +ADD { split. } +GOALS +ADD here { split. } +GOALS +PDIFF here +ADD there { auto. } +GOALS +PDIFF there +ADD { Admitted. } diff --git a/test-suite/micromega/int63.v b/test-suite/micromega/int63.v new file mode 100644 index 0000000000..20dfa2631e --- /dev/null +++ b/test-suite/micromega/int63.v @@ -0,0 +1,24 @@ +Require Import ZArith ZifyInt63 Lia. +Require Import Int63. + +Open Scope int63_scope. + +Goal forall (x:int), 0 <= x = true. +Proof. lia. Qed. + +Goal max_int = 9223372036854775807. +Proof. lia. Qed. + +Goal digits = 63. +Proof. lia. Qed. + +Goal wB = (2^63)%Z. +Proof. lia. Qed. + +Goal forall x y, x + y <= max_int = true. +Proof. lia. Qed. + +Goal forall x, x <> 0 -> x / x = 1. +Proof. + nia. +Qed. diff --git a/test-suite/output/DependentInductionErrors.out b/test-suite/output/DependentInductionErrors.out new file mode 100644 index 0000000000..4a83375f6f --- /dev/null +++ b/test-suite/output/DependentInductionErrors.out @@ -0,0 +1,4 @@ +The command has indeed failed with message: +Tactic failure: To use dependent destruction, first [Require Import Coq.Program.Equality.]. +The command has indeed failed with message: +Tactic failure: To use dependent induction, first [Require Import Coq.Program.Equality.]. diff --git a/test-suite/output/DependentInductionErrors.v b/test-suite/output/DependentInductionErrors.v new file mode 100644 index 0000000000..2fce00f9fd --- /dev/null +++ b/test-suite/output/DependentInductionErrors.v @@ -0,0 +1,17 @@ +Theorem foo (b:bool) : b = true \/ b = false. +Proof. + Fail dependent destruction b. + Fail dependent induction b. +Abort. + +From Coq Require Import Program.Equality. + +Theorem foo_with_destruction (b:bool) : b = true \/ b = false. +Proof. + dependent destruction b; auto. +Qed. + +Theorem foo_with_induction (b:bool) : b = true \/ b = false. +Proof. + dependent induction b; auto. +Qed. diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out index abada44da7..bd22d45059 100644 --- a/test-suite/output/Notations3.out +++ b/test-suite/output/Notations3.out @@ -231,16 +231,13 @@ fun l : list nat => match l with : list nat -> list nat Arguments foo _%list_scope -Notation -"'exists' x .. y , p" := ex (fun x => .. (ex (fun y => p)) ..) : type_scope -(default interpretation) -"'exists' ! x .. y , p" := ex - (unique - (fun x => .. (ex (unique (fun y => p))) ..)) -: type_scope (default interpretation) -Notation -"( x , y , .. , z )" := pair .. (pair x y) .. z : core_scope -(default interpretation) +Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..)) + : type_scope (default interpretation) +Notation "'exists' ! x .. y , p" := + (ex (unique (fun x => .. (ex (unique (fun y => p))) ..))) : type_scope + (default interpretation) +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope + (default interpretation) 1 subgoal ============================ diff --git a/test-suite/output/Record.out b/test-suite/output/Record.out index d45343fe60..7de1e7d559 100644 --- a/test-suite/output/Record.out +++ b/test-suite/output/Record.out @@ -30,3 +30,43 @@ fun '{| U := T; a := a; q := p |} => (T, p, a) : M -> Type * True * nat fun '{| U := T; a := a; q := p |} => (T, p, a) : M -> Type * True * nat +{| a := 0; b := 0 |} + : T +fun '{| |} => 0 + : LongModuleName.test -> nat + = {| + a := + {| + LongModuleName.long_field_name0 := 0; + LongModuleName.long_field_name1 := 1; + LongModuleName.long_field_name2 := 2; + LongModuleName.long_field_name3 := 3 + |}; + b := + fun + '{| + LongModuleName.long_field_name0 := a; + LongModuleName.long_field_name1 := b; + LongModuleName.long_field_name2 := c; + LongModuleName.long_field_name3 := d + |} => (a, b, c, d) + |} + : T + = {| + a := + {| + long_field_name0 := 0; + long_field_name1 := 1; + long_field_name2 := 2; + long_field_name3 := 3 + |}; + b := + fun + '{| + long_field_name0 := a; + long_field_name1 := b; + long_field_name2 := c; + long_field_name3 := d + |} => (a, b, c, d) + |} + : T diff --git a/test-suite/output/Record.v b/test-suite/output/Record.v index 71a8afa131..13ea37b11e 100644 --- a/test-suite/output/Record.v +++ b/test-suite/output/Record.v @@ -33,3 +33,34 @@ Check fun x:M => let 'D T _ p := x in T. Check fun x:M => let 'D T p := x in (T,p). Check fun x:M => let 'D T a p := x in (T,p,a). Check fun x:M => let '{|U:=T;a:=a;q:=p|} := x in (T,p,a). + +Module FormattingIssue13142. + +Record T {A B} := {a:A;b:B}. + +Module LongModuleName. + Record test := { long_field_name0 : nat; + long_field_name1 : nat; + long_field_name2 : nat; + long_field_name3 : nat }. +End LongModuleName. + +Definition c := + {| LongModuleName.long_field_name0 := 0; + LongModuleName.long_field_name1 := 1; + LongModuleName.long_field_name2 := 2; + LongModuleName.long_field_name3 := 3 |}. + +Definition d := + fun '{| LongModuleName.long_field_name0 := a; + LongModuleName.long_field_name1 := b; + LongModuleName.long_field_name2 := c; + LongModuleName.long_field_name3 := d |} => (a,b,c,d). + +Check {|a:=0;b:=0|}. +Check fun '{| LongModuleName.long_field_name0:=_ |} => 0. +Eval compute in {|a:=c;b:=d|}. +Import LongModuleName. +Eval compute in {|a:=c;b:=d|}. + +End FormattingIssue13142. diff --git a/test-suite/output/bug_12908.out b/test-suite/output/bug_12908.out index fca6dde704..54c4f98422 100644 --- a/test-suite/output/bug_12908.out +++ b/test-suite/output/bug_12908.out @@ -1,2 +1,7 @@ forall m n : nat, m * n = (2 * m * n)%nat : Prop +File "stdin", line 11, characters 0-31: +Warning: Notation "_ * _" was already used in scope nat_scope. +[notation-overridden,parsing] +forall m n : nat, m * n = Nat.mul (Nat.mul 2 m) n + : Prop diff --git a/test-suite/output/bug_12908.v b/test-suite/output/bug_12908.v index 558c9f9f6a..6f7be22fa0 100644 --- a/test-suite/output/bug_12908.v +++ b/test-suite/output/bug_12908.v @@ -1,6 +1,13 @@ Definition mult' m n := 2 * m * n. + Module A. (* Test hiding of a scoped notation by a lonely notation *) Infix "*" := mult'. Check forall m n, mult' m n = Nat.mul (Nat.mul 2 m) n. End A. + +Module B. +(* Test that an overriden scoped notation is deactivated *) +Infix "*" := mult' : nat_scope. +Check forall m n, mult' m n = Nat.mul (Nat.mul 2 m) n. +End B. diff --git a/test-suite/output/bug_13112.out b/test-suite/output/bug_13112.out new file mode 100644 index 0000000000..a8a98d6b68 --- /dev/null +++ b/test-suite/output/bug_13112.out @@ -0,0 +1,4 @@ +0 + 0 + : nat +HI + : nat diff --git a/test-suite/output/bug_13112.v b/test-suite/output/bug_13112.v new file mode 100644 index 0000000000..9fee5e09d8 --- /dev/null +++ b/test-suite/output/bug_13112.v @@ -0,0 +1,5 @@ +Reserved Notation "'HI'". +Notation "'HI'" := (O + O) (only parsing). +Check HI. (* 0 + 0 : nat *) +Notation "'HI'" := (O + O) (only printing). +Check HI. (* 0 + 0 : nat *) diff --git a/test-suite/output/bug_9180.out b/test-suite/output/bug_9180.out index ed4892b389..f035d0252a 100644 --- a/test-suite/output/bug_9180.out +++ b/test-suite/output/bug_9180.out @@ -1,4 +1,3 @@ -Notation -"n .+1" := S n : nat_scope (default interpretation) +Notation "n .+1" := (S n) : nat_scope (default interpretation) forall x : nat, x.+1 = x.+1 : Prop diff --git a/test-suite/output/bug_9682.out b/test-suite/output/bug_9682.out new file mode 100644 index 0000000000..45d9e4cad1 --- /dev/null +++ b/test-suite/output/bug_9682.out @@ -0,0 +1,9 @@ +mmatch 1 + 2 + 3 + 4 + 5 + 6 in nat as x +return M (x = x) with +| 1 +end + : unit +# + : True +## + : True diff --git a/test-suite/output/bug_9682.v b/test-suite/output/bug_9682.v new file mode 100644 index 0000000000..fa30d323ef --- /dev/null +++ b/test-suite/output/bug_9682.v @@ -0,0 +1,28 @@ +Declare Scope blafu. +Delimit Scope blafu with B. +Axiom DoesNotMatch : Type. +Axiom consumer : forall {A} (B : A -> Type) (E:Type) (x : A) (ls : list nat), unit. + +Notation "| p1 | .. | pn" := (@cons _ p1 .. (@cons _ pn nil) ..) (at level 91) : blafu. +Notation "'mmatch_do_not_write' x 'in' T 'as' y 'return' 'M' p 'with_do_not_write' ls" := + (@consumer _ (fun y : T => p%type) DoesNotMatch x ls%B) + (at level 200, ls at level 91, only parsing). +Notation "'mmatch' x 'in' T 'as' y 'return' 'M' p 'with' ls 'end'" := + (mmatch_do_not_write x in T as y return M p with_do_not_write ls) + (at level 200, ls at level 91, p at level 10, only parsing). +(* This should not gives a warning *) +Notation "'mmatch' x 'in' T 'as' y 'return' 'M' p 'with' ls 'end'" := + (@consumer _ (fun y : T => p%type) DoesNotMatch x ls%B) + (at level 200, ls at level 91, p at level 10, only printing, + format "'[ ' mmatch '/' x ']' '/' '[ ' in '/' T ']' '/' '[ ' as '/' y ']' '/' '[ ' return M p ']' with '//' '[' ls ']' '//' end" + ). +(* Check use of "mmatch" *) +Check (mmatch 1 + 2 + 3 + 4 + 5 + 6 in nat as x return M (x = x) with | 1 end). + +(* 2nd example *) +Notation "#" := I (at level 0, only parsing). +Notation "#" := I (at level 0, only printing). +Check #. +Notation "##" := I (at level 0, only printing). +Notation "##" := I (at level 0, only parsing). +Check ##. diff --git a/test-suite/output/goal_output.out b/test-suite/output/goal_output.out index 773533a8d3..17c1aaa55b 100644 --- a/test-suite/output/goal_output.out +++ b/test-suite/output/goal_output.out @@ -2,7 +2,79 @@ Nat.t = nat : Set Nat.t = nat : Set +2 subgoals + + ============================ + True + +subgoal 2 is: + True +2 subgoals, subgoal 1 (?Goal) + + ============================ + True + +subgoal 2 (?Goal0) is: + True 1 subgoal ============================ - False + True +1 subgoal (?Goal0) + + ============================ + True +1 subgoal (?Goal0) + + ============================ + True + +*** Unfocused goals: + +subgoal 2 (?Goal1) is: + True +subgoal 3 (?Goal) is: + True +1 subgoal + + ============================ + True + +*** Unfocused goals: + +subgoal 2 is: + True +subgoal 3 is: + True +This subproof is complete, but there are some unfocused goals. +Focus next goal with bullet -. + +2 subgoals + +subgoal 1 is: + True +subgoal 2 is: + True +This subproof is complete, but there are some unfocused goals. +Focus next goal with bullet -. + +2 subgoals + +subgoal 1 (?Goal0) is: + True +subgoal 2 (?Goal) is: + True +This subproof is complete, but there are some unfocused goals. +Focus next goal with bullet -. + +1 subgoal + +subgoal 1 is: + True +This subproof is complete, but there are some unfocused goals. +Focus next goal with bullet -. + +1 subgoal + +subgoal 1 (?Goal) is: + True diff --git a/test-suite/output/goal_output.v b/test-suite/output/goal_output.v index 327b80b0aa..b1ced94054 100644 --- a/test-suite/output/goal_output.v +++ b/test-suite/output/goal_output.v @@ -6,8 +6,32 @@ Print Nat.t. Timeout 1 Print Nat.t. -Lemma toto: False. Set Printing All. +Lemma toto: True/\True. +Proof. +split. Show. +Set Printing Goal Names. +Show. +Unset Printing Goal Names. +assert True. +- idtac. +Show. +Set Printing Goal Names. +Show. +Set Printing Unfocused. +Show. +Unset Printing Goal Names. +Show. +Unset Printing Unfocused. + auto. +Show. +Set Printing Goal Names. +Show. +Unset Printing Goal Names. +- auto. +Show. +Set Printing Goal Names. +Show. +Unset Printing Goal Names. Abort. - diff --git a/test-suite/output/locate.out b/test-suite/output/locate.out index 473db2d312..93d9d6cf7b 100644 --- a/test-suite/output/locate.out +++ b/test-suite/output/locate.out @@ -1,3 +1,2 @@ -Notation -"b1 && b2" := if b1 then b2 else false (default interpretation) -"x && y" := andb x y : bool_scope +Notation "b1 && b2" := (if b1 then b2 else false) (default interpretation) +Notation "x && y" := (andb x y) : bool_scope diff --git a/test-suite/primitive/arrays/reroot.v b/test-suite/primitive/arrays/reroot.v deleted file mode 100644 index 172a118cc7..0000000000 --- a/test-suite/primitive/arrays/reroot.v +++ /dev/null @@ -1,22 +0,0 @@ -From Coq Require Import Int63 PArray. - -Open Scope array_scope. - -Definition t : array nat := [| 1; 5; 2 | 4 |]. -Definition t' : array nat := PArray.reroot t. - -Definition foo1 := (eq_refl : t'.[1] = 5). -Definition foo2 := (eq_refl 5 <: t'.[1] = 5). -Definition foo3 := (eq_refl 5 <<: t'.[1] = 5). -Definition x1 := Eval compute in t'.[1]. -Definition foo4 := (eq_refl : x1 = 5). -Definition x2 := Eval cbn in t'.[1]. -Definition foo5 := (eq_refl : x2 = 5). - -Definition foo6 := (eq_refl : t.[1] = 5). -Definition foo7 := (eq_refl 5 <: t.[1] = 5). -Definition foo8 := (eq_refl 5 <<: t.[1] = 5). -Definition x3 := Eval compute in t.[1]. -Definition foo9 := (eq_refl : x3 = 5). -Definition x4 := Eval cbn in t.[1]. -Definition foo10 := (eq_refl : x4 = 5). diff --git a/test-suite/success/Nsatz.v b/test-suite/success/Nsatz.v index 998f3f7dd1..73e98ea920 100644 --- a/test-suite/success/Nsatz.v +++ b/test-suite/success/Nsatz.v @@ -1,6 +1,8 @@ Require Import TestSuite.admit. (* compile en user 3m39.915s sur cachalot *) Require Import Nsatz. +Require List. +Import List.ListNotations. (* Example with a generic domain *) @@ -294,7 +296,7 @@ Lemma minh: forall A B C D O E H I:point, Proof. geo_begin. idtac "minh". Time nsatz with radicalmax :=1%N strategy:=1%Z - parameters:=(X O::X B::X C::nil) + parameters:=[X O; X B; X C] variables:= (@nil R). (*Finished transaction in 13. secs (10.102464u,0.s) *) @@ -314,15 +316,15 @@ Proof. geo_begin. idtac "Pappus". Time nsatz with radicalmax :=1%N strategy:=0%Z - parameters:=(X B::X A1::Y A1::X B1::Y B1::X C::Y C1::nil) - variables:= (X B - :: X A1 - :: Y A1 - :: X B1 - :: Y B1 - :: X C - :: Y C1 - :: X C1 :: Y P :: X P :: Y Q :: X Q :: Y S :: X S :: nil). + parameters:=[X B; X A1; Y A1; X B1; Y B1; X C; Y C1] + variables:= [X B; + X A1; + Y A1; + X B1; + Y B1; + X C; + Y C1; + X C1; Y P; X P; Y Q; X Q; Y S; X S]. (*Finished transaction in 8. secs (7.795815u,0.000999999999999s) *) Qed. @@ -347,7 +349,7 @@ Proof. geo_begin. idtac "Simson". Time nsatz with radicalmax :=1%N strategy:=0%Z - parameters:=(X B::Y B::X C::Y C::Y D::nil) + parameters:=[X B; Y B; X C; Y C; Y D] variables:= (@nil R). (* compute -[X Y]. *) (*Finished transaction in 8. secs (7.550852u,0.s) *) @@ -432,20 +434,20 @@ Proof. geo_begin. idtac "Desargues". Time -let lv := rev (X A - :: X B - :: Y B - :: X C - :: Y C - :: Y A1 :: X A1 - :: Y B1 - :: Y C1 - :: X T - :: Y T - :: X Q - :: Y Q :: X P :: Y P :: X C1 :: X B1 :: nil) in +let lv := rev [X A; + X B; + Y B; + X C; + Y C; + Y A1; X A1; + Y B1; + Y C1; + X T; + Y T; + X Q; + Y Q; X P; Y P; X C1; X B1] in nsatz with radicalmax :=1%N strategy:=0%Z - parameters:=(X A::X B::Y B::X C::Y C::X A1::Y B1::Y C1::nil) + parameters:=[X A; X B; Y B; X C; Y C; X A1; Y B1; Y C1] variables:= lv. (*Finished transaction in 8. secs (8.02578u,0.001s)*) Qed. @@ -522,9 +524,9 @@ Lemma hauteurs:forall A B C A1 B1 C1 H:point, geo_begin. idtac "hauteurs". Time - let lv := constr:(Y A1 - :: X A1 :: Y B1 :: X B1 :: Y A :: Y B :: X B :: X A :: X H :: Y C - :: Y C1 :: Y H :: X C1 :: X C :: (@Datatypes.nil R)) in + let lv := constr:([Y A1; + X A1; Y B1; X B1; Y A; Y B; X B; X A; X H; Y C; + Y C1; Y H; X C1; X C]) in nsatz with radicalmax := 2%N strategy := 1%Z parameters := (@Datatypes.nil R) variables := lv. (*Finished transaction in 5. secs (4.360337u,0.008999s)*) diff --git a/test-suite/success/Record.v b/test-suite/success/Record.v index ce07512a1e..beb424dd40 100644 --- a/test-suite/success/Record.v +++ b/test-suite/success/Record.v @@ -93,3 +93,18 @@ Record R : Type := { (* This is used in a couple of development such as UniMatch *) Record S {A:Type} := { a : A; b : forall A:Type, A }. + +(* Bug #13165 on implicit arguments in defined fields *) +Record T := { + f {n:nat} (p:n=n) := nat; + g := f (eq_refl 0) +}. + +(* Slight improvement in when SProp relevance is detected *) +Inductive True : SProp := I. +Inductive eqI : True -> SProp := reflI : eqI I. + +Record U (c:True) := { + u := c; + v := reflI : eqI u; + }. diff --git a/test-suite/success/polymorphism.v b/test-suite/success/polymorphism.v index 9ab8ace39e..0796b507a1 100644 --- a/test-suite/success/polymorphism.v +++ b/test-suite/success/polymorphism.v @@ -457,5 +457,10 @@ Module ObligationRegression. (** Test for a regression encountered when fixing obligations for stronger restriction of universe context. *) Require Import CMorphisms. - Check trans_co_eq_inv_arrow_morphism@{_ _ _ _ _ _ _ _}. + Check trans_co_eq_inv_arrow_morphism@{_ _ _ _ _ _ _}. End ObligationRegression. + +Axiom poly@{i} : forall(A : Type@{i}) (a : A), unit. + +Definition nonpoly := @poly True Logic.I. +Definition check := nonpoly@{}. diff --git a/theories/Array/PArray.v b/theories/Array/PArray.v index 3511ba0918..e91a5bf9ad 100644 --- a/theories/Array/PArray.v +++ b/theories/Array/PArray.v @@ -22,12 +22,6 @@ Arguments length {_} _. Primitive copy : forall A, array A -> array A := #array_copy. Arguments copy {_} _. -(* [reroot t] produces an array that is extensionaly equal to [t], but whose - history has been squashed. Useful when performing multiple accesses in an old - copy of an array that has been updated. *) -Primitive reroot : forall A, array A -> array A := #array_reroot. -Arguments reroot {_} _. - Module Export PArrayNotations. Declare Scope array_scope. @@ -64,9 +58,6 @@ Axiom length_set : forall A t i (a:A), Axiom get_copy : forall A (t:array A) i, (copy t).[i] = t.[i]. Axiom length_copy : forall A (t:array A), length (copy t) = length t. -Axiom get_reroot : forall A (t:array A) i, (reroot t).[i] = t.[i]. -Axiom length_reroot : forall A (t:array A), length (reroot t) = length t. - Axiom array_ext : forall A (t1 t2:array A), length t1 = length t2 -> (forall i, i <? length t1 = true -> t1.[i] = t2.[i]) -> @@ -94,16 +85,6 @@ Proof. rewrite !get_out_of_bounds in get_make; assumption. Qed. -Lemma default_reroot A (t:array A) : default (reroot t) = default t. -Proof. - assert (irr_lt : length t <? length t = false). - destruct (Int63.ltbP (length t) (length t)); try reflexivity. - exfalso; eapply BinInt.Z.lt_irrefl; eassumption. - assert (get_reroot := get_reroot A t (length t)). - rewrite !get_out_of_bounds in get_reroot; try assumption. - rewrite length_reroot; assumption. -Qed. - Lemma get_set_same_default A (t : array A) (i : int) : t.[i <- default t].[i] = default t. Proof. diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v index e1db68aea9..35bab1021e 100644 --- a/theories/Init/Tactics.v +++ b/theories/Init/Tactics.v @@ -245,13 +245,16 @@ Tactic Notation "clear" "dependent" hyp(h) := Tactic Notation "revert" "dependent" hyp(h) := generalize dependent h. -(** Provide an error message for dependent induction that reports an import is -required to use it. Importing Coq.Program.Equality will shadow this notation -with the actual [dependent induction] tactic. *) +(** Provide an error message for dependent induction/dependent destruction that + reports an import is required to use it. Importing Coq.Program.Equality will + shadow this notation with the actual tactics. *) Tactic Notation "dependent" "induction" ident(H) := fail "To use dependent induction, first [Require Import Coq.Program.Equality.]". +Tactic Notation "dependent" "destruction" ident(H) := + fail "To use dependent destruction, first [Require Import Coq.Program.Equality.]". + (** *** [inversion_sigma] *) (** The built-in [inversion] will frequently leave equalities of dependent pairs. When the first type in the pair is an hProp or diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index 4fa8b3216a..993b7b3ec4 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -459,12 +459,12 @@ Lemma Rplus_eq_0_l : forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0. Proof. intros a b H [H0| H0] H1; auto with real. - absurd (0 < a + b). - rewrite H1; auto with real. - apply Rle_lt_trans with (a + 0). - rewrite Rplus_0_r; assumption. - auto using Rplus_lt_compat_l with real. - rewrite <- H0, Rplus_0_r in H1; assumption. + - absurd (0 < a + b). + + rewrite H1; auto with real. + + apply Rle_lt_trans with (a + 0). + * rewrite Rplus_0_r; assumption. + * auto using Rplus_lt_compat_l with real. + - rewrite <- H0, Rplus_0_r in H1; assumption. Qed. Lemma Rplus_eq_R0 : @@ -1529,7 +1529,7 @@ Qed. Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1. Proof. - intros x y H' H'0. + intros x y H' H'0. cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ]; auto with real. apply Rmult_lt_reg_l with (r := x); auto with real. @@ -1753,11 +1753,11 @@ Qed. Lemma INR_IPR : forall p, INR (Pos.to_nat p) = IPR p. Proof. assert (H: forall p, 2 * INR (Pos.to_nat p) = IPR_2 p). - induction p as [p|p|] ; simpl IPR_2. + { induction p as [p|p|] ; simpl IPR_2. rewrite Pos2Nat.inj_xI, S_INR, mult_INR, <- IHp. now rewrite (Rplus_comm (2 * _)). now rewrite Pos2Nat.inj_xO, mult_INR, <- IHp. - apply Rmult_1_r. + apply Rmult_1_r. } intros [p|p|] ; unfold IPR. rewrite Pos2Nat.inj_xI, S_INR, mult_INR, <- H. apply Rplus_comm. @@ -1830,12 +1830,12 @@ Qed. Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Z.pow z (Z.of_nat n)). Proof. - intros z [|n];simpl;trivial. - rewrite Zpower_pos_nat. - rewrite SuccNat2Pos.id_succ. unfold Zpower_nat;simpl. - rewrite mult_IZR. - induction n;simpl;trivial. - rewrite mult_IZR;ring[IHn]. + intros z [|n];simpl;trivial. + rewrite Zpower_pos_nat. + rewrite SuccNat2Pos.id_succ. unfold Zpower_nat;simpl. + rewrite mult_IZR. + induction n;simpl;trivial. + rewrite mult_IZR;ring[IHn]. Qed. (**********) @@ -2043,7 +2043,7 @@ Proof. Qed. Lemma Ropp_div : forall x y, -x/y = - (x / y). -intros x y; unfold Rdiv; ring. + intros x y; unfold Rdiv; ring. Qed. Lemma Ropp_div_den : forall x y : R, y<>0 -> x / - y = - (x / y). @@ -2068,22 +2068,22 @@ Lemma R_rm : ring_morph 0%R 1%R Rplus Rmult Rminus Ropp eq 0%Z 1%Z Zplus Zmult Zminus Z.opp Zeq_bool IZR. Proof. -constructor ; try easy. -exact plus_IZR. -exact minus_IZR. -exact mult_IZR. -exact opp_IZR. -intros x y H. -apply f_equal. -now apply Zeq_bool_eq. + constructor ; try easy. + - exact plus_IZR. + - exact minus_IZR. + - exact mult_IZR. + - exact opp_IZR. + - intros x y H. + apply f_equal. + now apply Zeq_bool_eq. Qed. Lemma Zeq_bool_IZR x y : IZR x = IZR y -> Zeq_bool x y = true. Proof. -intros H. -apply Zeq_is_eq_bool. -now apply eq_IZR. + intros H. + apply Zeq_is_eq_bool. + now apply eq_IZR. Qed. Add Field RField : Rfield @@ -2127,15 +2127,15 @@ Qed. Lemma Rdiv_lt_0_compat : forall a b, 0 < a -> 0 < b -> 0 < a/b. Proof. -intros; apply Rmult_lt_0_compat;[|apply Rinv_0_lt_compat]; assumption. + intros; apply Rmult_lt_0_compat;[|apply Rinv_0_lt_compat]; assumption. Qed. Lemma Rdiv_plus_distr : forall a b c, (a + b)/c = a/c + b/c. -intros a b c; apply Rmult_plus_distr_r. + intros a b c; apply Rmult_plus_distr_r. Qed. Lemma Rdiv_minus_distr : forall a b c, (a - b)/c = a/c - b/c. -intros a b c; unfold Rminus, Rdiv; rewrite Rmult_plus_distr_r; ring. + intros a b c; unfold Rminus, Rdiv; rewrite Rmult_plus_distr_r; ring. Qed. (* A test for equality function. *) diff --git a/theories/extraction/ExtrOCamlPArray.v b/theories/extraction/ExtrOCamlPArray.v index 67646bdb53..56d40c1d16 100644 --- a/theories/extraction/ExtrOCamlPArray.v +++ b/theories/extraction/ExtrOCamlPArray.v @@ -23,4 +23,3 @@ Extract Constant PArray.default => "Parray.default". Extract Constant PArray.set => "Parray.set". Extract Constant PArray.length => "Parray.length". Extract Constant PArray.copy => "Parray.copy". -Extract Constant PArray.reroot => "Parray.reroot". diff --git a/theories/micromega/Zify.v b/theories/micromega/Zify.v index 183fd6a914..01cc9ad810 100644 --- a/theories/micromega/Zify.v +++ b/theories/micromega/Zify.v @@ -16,11 +16,22 @@ Ltac zify_pre_hook := idtac. Ltac zify_post_hook := idtac. -Ltac iter_specs := zify_iter_specs. +Ltac zify_convert_to_euclidean_division_equations_flag := constr:(false). + +(** [zify_internal_to_euclidean_division_equations] is bound in [PreOmega] *) +Ltac zify_internal_to_euclidean_division_equations := idtac. + +Ltac zify_to_euclidean_division_equations := + lazymatch zify_convert_to_euclidean_division_equations_flag with + | true => zify_internal_to_euclidean_division_equations + | false => idtac + end. + Ltac zify := intros; zify_pre_hook ; zify_elim_let ; zify_op ; (zify_iter_specs) ; - zify_saturate ; zify_post_hook. + zify_saturate ; + zify_to_euclidean_division_equations ; zify_post_hook. diff --git a/theories/micromega/ZifyInt63.v b/theories/micromega/ZifyInt63.v new file mode 100644 index 0000000000..27845898aa --- /dev/null +++ b/theories/micromega/ZifyInt63.v @@ -0,0 +1,178 @@ +Require Import ZArith. +Require Import Int63. +Require Import ZifyBool. +Import ZifyClasses. + +Lemma to_Z_bounded : forall x, (0 <= to_Z x < 9223372036854775808)%Z. +Proof. apply to_Z_bounded. Qed. + +Instance Inj_int_Z : InjTyp int Z := + mkinj _ _ to_Z (fun x => 0 <= x < 9223372036854775808)%Z to_Z_bounded. +Add Zify InjTyp Inj_int_Z. + +Instance Op_max_int : CstOp max_int := + { TCst := 9223372036854775807 ; TCstInj := eq_refl }. +Add Zify CstOp Op_max_int. + +Instance Op_digits : CstOp digits := + { TCst := 63 ; TCstInj := eq_refl }. +Add Zify CstOp Op_digits. + +Instance Op_size : CstOp size := + { TCst := 63 ; TCstInj := eq_refl }. +Add Zify CstOp Op_size. + +Instance Op_wB : CstOp wB := + { TCst := 2^63 ; TCstInj := eq_refl }. +Add Zify CstOp Op_wB. + +Lemma ltb_lt : forall n m, + (n <? m)%int63 = (φ (n)%int63 <? φ (m)%int63)%Z. +Proof. + intros. apply Bool.eq_true_iff_eq. + rewrite ltb_spec. rewrite <- Z.ltb_lt. + apply iff_refl. +Qed. + +Instance Op_ltb : BinOp ltb := + {| TBOp := Z.ltb; TBOpInj := ltb_lt |}. +Add Zify BinOp Op_ltb. + +Lemma leb_le : forall n m, + (n <=? m)%int63 = (φ (n)%int63 <=? φ (m)%int63)%Z. +Proof. + intros. apply Bool.eq_true_iff_eq. + rewrite leb_spec. rewrite <- Z.leb_le. + apply iff_refl. +Qed. + +Instance Op_leb : BinOp leb := + {| TBOp := Z.leb; TBOpInj := leb_le |}. +Add Zify BinOp Op_leb. + +Lemma eqb_eq : forall n m, + (n =? m)%int63 = (φ (n)%int63 =? φ (m)%int63)%Z. +Proof. + intros. apply Bool.eq_true_iff_eq. + rewrite eqb_spec. rewrite Z.eqb_eq. + split ; intro H. + now subst; reflexivity. + now apply to_Z_inj in H. +Qed. + +Instance Op_eqb : BinOp eqb := + {| TBOp := Z.eqb; TBOpInj := eqb_eq |}. +Add Zify BinOp Op_eqb. + +Lemma eq_int_inj : forall n m : int, n = m <-> (φ n = φ m)%int63. +Proof. + split; intro H. + rewrite H ; reflexivity. + apply to_Z_inj; auto. +Qed. + +Instance Op_eq : BinRel (@eq int) := + {| TR := @eq Z; TRInj := eq_int_inj |}. +Add Zify BinRel Op_eq. + +Instance Op_add : BinOp add := + {| TBOp := fun x y => (x + y) mod 9223372036854775808%Z; TBOpInj := add_spec |}%Z. +Add Zify BinOp Op_add. + +Instance Op_sub : BinOp sub := + {| TBOp := fun x y => (x - y) mod 9223372036854775808%Z; TBOpInj := sub_spec |}%Z. +Add Zify BinOp Op_sub. + +Instance Op_opp : UnOp Int63.opp := + {| TUOp := (fun x => (- x) mod 9223372036854775808)%Z; TUOpInj := (sub_spec 0) |}%Z. +Add Zify UnOp Op_opp. + +Instance Op_oppcarry : UnOp oppcarry := + {| TUOp := (fun x => 2^63 - x - 1)%Z; TUOpInj := oppcarry_spec |}%Z. +Add Zify UnOp Op_oppcarry. + +Instance Op_succ : UnOp succ := + {| TUOp := (fun x => (x + 1) mod 2^63)%Z; TUOpInj := succ_spec |}%Z. +Add Zify UnOp Op_succ. + +Instance Op_pred : UnOp Int63.pred := + {| TUOp := (fun x => (x - 1) mod 2^63)%Z; TUOpInj := pred_spec |}%Z. +Add Zify UnOp Op_pred. + +Instance Op_mul : BinOp mul := + {| TBOp := fun x y => (x * y) mod 9223372036854775808%Z; TBOpInj := mul_spec |}%Z. +Add Zify BinOp Op_mul. + +Instance Op_gcd : BinOp gcd:= + {| TBOp := (fun x y => Zgcd_alt.Zgcdn (2 * 63)%nat y x) ; TBOpInj := to_Z_gcd |}. +Add Zify BinOp Op_gcd. + +Instance Op_mod : BinOp Int63.mod := + {| TBOp := Z.modulo ; TBOpInj := mod_spec |}. +Add Zify BinOp Op_mod. + +Instance Op_subcarry : BinOp subcarry := + {| TBOp := (fun x y => (x - y - 1) mod 2^63)%Z ; TBOpInj := subcarry_spec |}. +Add Zify BinOp Op_subcarry. + +Instance Op_addcarry : BinOp addcarry := + {| TBOp := (fun x y => (x + y + 1) mod 2^63)%Z ; TBOpInj := addcarry_spec |}. +Add Zify BinOp Op_addcarry. + +Instance Op_lsr : BinOp lsr := + {| TBOp := (fun x y => x / 2^ y)%Z ; TBOpInj := lsr_spec |}. +Add Zify BinOp Op_lsr. + +Instance Op_lsl : BinOp lsl := + {| TBOp := (fun x y => (x * 2^ y) mod 2^ 63)%Z ; TBOpInj := lsl_spec |}. +Add Zify BinOp Op_lsl. + +Instance Op_lor : BinOp Int63.lor := + {| TBOp := Z.lor ; TBOpInj := lor_spec' |}. +Add Zify BinOp Op_lor. + +Instance Op_land : BinOp Int63.land := + {| TBOp := Z.land ; TBOpInj := land_spec' |}. +Add Zify BinOp Op_land. + +Instance Op_lxor : BinOp Int63.lxor := + {| TBOp := Z.lxor ; TBOpInj := lxor_spec' |}. +Add Zify BinOp Op_lxor. + +Instance Op_div : BinOp div := + {| TBOp := Z.div ; TBOpInj := div_spec |}. +Add Zify BinOp Op_div. + +Instance Op_bit : BinOp bit := + {| TBOp := Z.testbit ; TBOpInj := bitE |}. +Add Zify BinOp Op_bit. + +Instance Op_of_Z : UnOp of_Z := + { TUOp := (fun x => x mod 9223372036854775808)%Z; TUOpInj := of_Z_spec }. +Add Zify UnOp Op_of_Z. + +Instance Op_to_Z : UnOp to_Z := + { TUOp := fun x => x ; TUOpInj := fun x : int => eq_refl }. +Add Zify UnOp Op_to_Z. + +Instance Op_is_zero : UnOp is_zero := + { TUOp := (Z.eqb 0) ; TUOpInj := is_zeroE }. +Add Zify UnOp Op_is_zero. + +Lemma is_evenE : forall x, + is_even x = Z.even φ (x)%int63. +Proof. + intros. + generalize (is_even_spec x). + rewrite Z_evenE. + destruct (is_even x). + symmetry. apply Z.eqb_eq. auto. + symmetry. apply Z.eqb_neq. congruence. +Qed. + +Instance Op_is_even : UnOp is_even := + { TUOp := Z.even ; TUOpInj := is_evenE }. +Add Zify UnOp Op_is_even. + + +Ltac Zify.zify_convert_to_euclidean_division_equations_flag ::= constr:(true). diff --git a/theories/omega/PreOmega.v b/theories/omega/PreOmega.v index 506a4108ee..70f25e7243 100644 --- a/theories/omega/PreOmega.v +++ b/theories/omega/PreOmega.v @@ -573,4 +573,6 @@ Ltac zify_N := repeat zify_N_rel; repeat zify_N_op; unfold Z_of_N' in *. Require Import ZifyClasses ZifyInst. Require Zify. +Ltac Zify.zify_internal_to_euclidean_division_equations ::= Z.to_euclidean_division_equations. + Ltac zify := Zify.zify. diff --git a/theories/ssr/ssrbool.v b/theories/ssr/ssrbool.v index f35da63fd6..e8a036bbb0 100644 --- a/theories/ssr/ssrbool.v +++ b/theories/ssr/ssrbool.v @@ -1401,8 +1401,8 @@ Definition mem T (pT : predType T) : pT -> mem_pred T := let: PredType toP := pT in fun A => Mem [eta toP A]. Arguments mem {T pT} A : rename, simpl never. -Notation "x \in A" := (in_mem x (mem A)) : bool_scope. -Notation "x \in A" := (in_mem x (mem A)) : bool_scope. +Notation "x \in A" := (in_mem x (mem A)) (only parsing) : bool_scope. +Notation "x \in A" := (in_mem x (mem A)) (only printing) : bool_scope. Notation "x \notin A" := (~~ (x \in A)) : bool_scope. Notation "A =i B" := (eq_mem (mem A) (mem B)) : type_scope. Notation "{ 'subset' A <= B }" := (sub_mem (mem A) (mem B)) : type_scope. @@ -1573,9 +1573,12 @@ Arguments has_quality n {T}. Lemma qualifE n T p x : (x \in @Qualifier n T p) = p x. Proof. by []. Qed. -Notation "x \is A" := (x \in has_quality 0 A) : bool_scope. -Notation "x \is 'a' A" := (x \in has_quality 1 A) : bool_scope. -Notation "x \is 'an' A" := (x \in has_quality 2 A) : bool_scope. +Notation "x \is A" := (x \in has_quality 0 A) (only parsing) : bool_scope. +Notation "x \is A" := (x \in has_quality 0 A) (only printing) : bool_scope. +Notation "x \is 'a' A" := (x \in has_quality 1 A) (only parsing) : bool_scope. +Notation "x \is 'a' A" := (x \in has_quality 1 A) (only printing) : bool_scope. +Notation "x \is 'an' A" := (x \in has_quality 2 A) (only parsing) : bool_scope. +Notation "x \is 'an' A" := (x \in has_quality 2 A) (only printing) : bool_scope. Notation "x \isn't A" := (x \notin has_quality 0 A) : bool_scope. Notation "x \isn't 'a' A" := (x \notin has_quality 1 A) : bool_scope. Notation "x \isn't 'an' A" := (x \notin has_quality 2 A) : bool_scope. diff --git a/topbin/coqtacticworker_bin.ml b/topbin/coqtacticworker_bin.ml index 252c8faa05..706554e025 100644 --- a/topbin/coqtacticworker_bin.ml +++ b/topbin/coqtacticworker_bin.ml @@ -8,6 +8,6 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -module W = AsyncTaskQueue.MakeWorker(Stm.TacTask) () +module W = AsyncTaskQueue.MakeWorker(Partac.TacTask) () let () = WorkerLoop.start ~init:W.init_stdout ~loop:W.main_loop "coqtacticworker" diff --git a/toplevel/coqargs.ml b/toplevel/coqargs.ml index eb386ea3e8..d587e57fd8 100644 --- a/toplevel/coqargs.ml +++ b/toplevel/coqargs.ml @@ -508,6 +508,7 @@ let parse_args ~help ~init arglist : t * string list = |"-color" -> set_color oval (next ()) |"-config"|"--config" -> set_query oval PrintConfig |"-debug" -> Coqinit.set_debug (); oval + |"-xml-debug" -> Flags.xml_debug := true; Coqinit.set_debug (); oval |"-diffs" -> add_set_option oval Proof_diffs.opt_name @@ Stm.OptionSet (Some (next ())) |"-stm-debug" -> Stm.stm_debug := true; oval diff --git a/toplevel/coqinit.ml b/toplevel/coqinit.ml index 9faa455657..501047c520 100644 --- a/toplevel/coqinit.ml +++ b/toplevel/coqinit.ml @@ -56,14 +56,21 @@ let build_stdlib_vo_path ~unix_path ~coq_path = let open Loadpath in { unix_path; coq_path ; has_ml = false; implicit = true; recursive = true } +(* Note we don't use has_ml=true due to #12771 , we need to see if we + should just remove that option *) let build_userlib_path ~unix_path = let open Loadpath in - { unix_path - ; coq_path = Libnames.default_root_prefix - ; has_ml = true - ; implicit = false - ; recursive = true - } + if Sys.file_exists unix_path then + let ml_path = System.all_subdirs ~unix_path |> List.map fst in + let vo_path = + { unix_path + ; coq_path = Libnames.default_root_prefix + ; has_ml = false + ; implicit = false + ; recursive = true + } in + ml_path, [vo_path] + else [], [] (* LoadPath for Coq user libraries *) let libs_init_load_path ~coqlib = @@ -75,24 +82,30 @@ let libs_init_load_path ~coqlib = let coq_path = Names.DirPath.make [Libnames.coq_root] in (* ML includes *) - let plugins_dirs = System.all_subdirs ~unix_path:(coqlib/"plugins") in - List.map fst plugins_dirs, - - (* current directory (not recursively!) *) - [ { unix_path = "." - ; coq_path = Libnames.default_root_prefix - ; implicit = false - ; has_ml = true - ; recursive = false - } ] @ - - (* then standard library *) - [build_stdlib_vo_path ~unix_path:(coqlib/"theories") ~coq_path] @ - - (* then user-contrib *) - (if Sys.file_exists user_contrib then - [build_userlib_path ~unix_path:user_contrib] else [] - ) @ - - (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME and COQPATH *) - List.map (fun s -> build_userlib_path ~unix_path:s) (xdg_dirs @ coqpath) + let plugins_dirs = System.all_subdirs ~unix_path:(coqlib/"plugins") |> List.map fst in + + let contrib_ml, contrib_vo = build_userlib_path ~unix_path:user_contrib in + + let misc_ml, misc_vo = + List.map (fun s -> build_userlib_path ~unix_path:s) (xdg_dirs @ coqpath) |> List.split in + + let ml_loadpath = plugins_dirs @ contrib_ml @ List.concat misc_ml in + let vo_loadpath = + (* current directory (not recursively!) *) + [ { unix_path = "." + ; coq_path = Libnames.default_root_prefix + ; implicit = false + ; has_ml = true + ; recursive = false + } ] @ + + (* then standard library *) + [build_stdlib_vo_path ~unix_path:(coqlib/"theories") ~coq_path] @ + + (* then user-contrib *) + contrib_vo @ + + (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME and COQPATH *) + List.concat misc_vo + in + ml_loadpath, vo_loadpath diff --git a/toplevel/coqinit.mli b/toplevel/coqinit.mli index 2bfbbde50e..b96a0ef162 100644 --- a/toplevel/coqinit.mli +++ b/toplevel/coqinit.mli @@ -14,7 +14,9 @@ val set_debug : unit -> unit val load_rcfile : rcfile:(string option) -> state:Vernac.State.t -> Vernac.State.t -(* LoadPath for Coq user libraries *) +(** Standard LoadPath for Coq user libraries; in particular it + includes (in-order) Coq's standard library, Coq's [user-contrib] + folder, and directories specified in [COQPATH] and [XDG_DIRS] *) val libs_init_load_path : coqlib:CUnix.physical_path -> CUnix.physical_path list * Loadpath.vo_path list diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml index 88924160ff..6460378edc 100644 --- a/toplevel/coqloop.ml +++ b/toplevel/coqloop.ml @@ -371,41 +371,13 @@ let exit_on_error = declare_bool_option_and_ref ~depr:false ~key:["Coqtop";"Exit";"On";"Error"] ~value:false -(* XXX: This is duplicated with Vernacentries.show_proof , at some - point we should consolidate the code *) -let show_proof_diff_to_pp pstate = - let p = Option.get pstate in - let sigma, env = Proof.get_proof_context p in - let pprf = Proof.partial_proof p in - Pp.prlist_with_sep Pp.fnl (Printer.pr_econstr_env env sigma) pprf - -let show_proof_diff_cmd ~state removed = +let show_proof_diff_cmd ~state diff_opt = let open Vernac.State in - try - let n_pp = show_proof_diff_to_pp state.proof in - if true (*Proof_diffs.show_diffs ()*) then - let doc = state.doc in - let oproof = Stm.get_prev_proof ~doc (Stm.get_current_state ~doc) in - try - let o_pp = show_proof_diff_to_pp oproof in - let tokenize_string = Proof_diffs.tokenize_string in - let show_removed = Some removed in - Pp_diff.diff_pp_combined ~tokenize_string ?show_removed o_pp n_pp - with - | Proof.NoSuchGoal _ - | Option.IsNone -> n_pp - | Pp_diff.Diff_Failure msg -> begin - (* todo: print the unparsable string (if we know it) *) - Feedback.msg_warning Pp.(str ("Diff failure: " ^ msg) ++ cut() - ++ str "Showing results without diff highlighting" ); - n_pp - end - else - n_pp - with - | Proof.NoSuchGoal _ - | Option.IsNone -> - CErrors.user_err (str "No goals to show.") + match state.proof with + | None -> CErrors.user_err (str "No proofs to diff.") + | Some proof -> + let old = Stm.get_prev_proof ~doc:state.doc state.sid in + Proof_diffs.diff_proofs ~diff_opt ?old proof let process_toplevel_command ~state stm = let open Vernac.State in @@ -444,12 +416,12 @@ let process_toplevel_command ~state stm = Feedback.msg_notice (v 0 (goal ++ evars)); state - | VernacShowProofDiffs removed -> + | VernacShowProofDiffs diff_opt -> (* We print nothing if there are no goals left *) if not (Proof_diffs.color_enabled ()) then CErrors.user_err Pp.(str "Show Proof Diffs requires setting the \"-color\" command line argument to \"on\" or \"auto\".") else - let out = show_proof_diff_cmd ~state removed in + let out = show_proof_diff_cmd ~state diff_opt in Feedback.msg_notice out; state diff --git a/toplevel/g_toplevel.mlg b/toplevel/g_toplevel.mlg index 1902103a3e..ef79f4562e 100644 --- a/toplevel/g_toplevel.mlg +++ b/toplevel/g_toplevel.mlg @@ -20,7 +20,7 @@ type vernac_toplevel = | VernacQuit | VernacControl of vernac_control | VernacShowGoal of { gid : int; sid: int } - | VernacShowProofDiffs of bool + | VernacShowProofDiffs of Proof_diffs.diffOpt module Toplevel_ : sig val vernac_toplevel : vernac_toplevel option Entry.t @@ -52,7 +52,8 @@ GRAMMAR EXTEND Gram | test_show_goal; IDENT "Show"; IDENT "Goal"; gid = natural; IDENT "at"; sid = natural; "." -> { Some (VernacShowGoal {gid; sid}) } | IDENT "Show"; IDENT "Proof"; IDENT "Diffs"; removed = OPT [ IDENT "removed" -> { () } ]; "." -> - { Some (VernacShowProofDiffs (removed <> None)) } + { Some (VernacShowProofDiffs + (if removed = None then Proof_diffs.DiffOn else Proof_diffs.DiffRemoved)) } | cmd = Pvernac.Vernac_.main_entry -> { match cmd with | None -> None diff --git a/toplevel/usage.ml b/toplevel/usage.ml index 732ad05b26..6fb5f821ee 100644 --- a/toplevel/usage.ml +++ b/toplevel/usage.ml @@ -72,6 +72,7 @@ let print_usage_common co command = \n -init-file f set the rcfile to f\ \n -bt print backtraces (requires configure debug flag)\ \n -debug debug mode (implies -bt)\ +\n -xml-debug debug mode and print XML messages to/from coqide\ \n -diffs (on|off|removed) highlight differences between proof steps\ \n -stm-debug STM debug mode (will trace every transaction)\ \n -noglob do not dump globalizations\ diff --git a/user-contrib/Ltac2/tac2quote.ml b/user-contrib/Ltac2/tac2quote.ml index b346b3ee5c..90f8008dc2 100644 --- a/user-contrib/Ltac2/tac2quote.ml +++ b/user-contrib/Ltac2/tac2quote.ml @@ -229,7 +229,7 @@ let check_pattern_id ?loc id = let pattern_vars pat = let rec aux () accu pat = match pat.CAst.v with | Constrexpr.CPatVar id - | Constrexpr.CEvar (id, []) -> + | Constrexpr.CEvar ({CAst.v=id}, []) -> let loc = pat.CAst.loc in let () = check_pattern_id ?loc id in Id.Map.add id loc accu diff --git a/vernac/classes.ml b/vernac/classes.ml index a464eab127..d5509e2697 100644 --- a/vernac/classes.ml +++ b/vernac/classes.ml @@ -152,9 +152,6 @@ let subst_class (subst,cl) = and do_subst c = Mod_subst.subst_mps subst c and do_subst_gr gr = fst (subst_global subst gr) in let do_subst_ctx = List.Smart.map (RelDecl.map_constr do_subst) in - let do_subst_context (grs,ctx) = - List.Smart.map (Option.Smart.map do_subst_gr) grs, - do_subst_ctx ctx in let do_subst_meth m = let c = Option.Smart.map do_subst_con m.meth_const in if c == m.meth_const then m @@ -168,7 +165,7 @@ let subst_class (subst,cl) = let do_subst_projs projs = List.Smart.map do_subst_meth projs in { cl_univs = cl.cl_univs; cl_impl = do_subst_gr cl.cl_impl; - cl_context = do_subst_context cl.cl_context; + cl_context = do_subst_ctx cl.cl_context; cl_props = do_subst_ctx cl.cl_props; cl_projs = do_subst_projs cl.cl_projs; cl_strict = cl.cl_strict; @@ -197,25 +194,16 @@ let discharge_class (_,cl) = | VarRef _ | ConstructRef _ -> assert false | ConstRef cst -> Lib.section_segment_of_constant cst | IndRef (ind,_) -> Lib.section_segment_of_mutual_inductive ind in - let discharge_context ctx' subst (grs, ctx) = - let env = Global.env () in - let sigma = Evd.from_env env in - let grs' = - let newgrs = List.map (fun decl -> - match decl |> RelDecl.get_type |> EConstr.of_constr |> class_of_constr env sigma with - | None -> None - | Some (_, ((tc,_), _)) -> Some tc.cl_impl) - ctx' - in - grs @ newgrs - in grs', discharge_rel_context subst 1 ctx @ ctx' in + let discharge_context ctx' subst ctx = + discharge_rel_context subst 1 ctx @ ctx' + in try let info = abs_context cl in let ctx = info.Section.abstr_ctx in let ctx, subst = rel_of_variable_context ctx in let usubst, cl_univs' = Lib.discharge_abstract_universe_context info cl.cl_univs in let context = discharge_context ctx (subst, usubst) cl.cl_context in - let props = discharge_rel_context (subst, usubst) (succ (List.length (fst cl.cl_context))) cl.cl_props in + let props = discharge_rel_context (subst, usubst) (succ (List.length cl.cl_context)) cl.cl_props in let discharge_proj x = x in { cl_univs = cl_univs'; cl_impl = cl.cl_impl; @@ -324,7 +312,7 @@ let declare_instance_constant iinfo global impargs ?hook name udecl poly sigma t let do_declare_instance sigma ~global ~poly k u ctx ctx' pri udecl impargs subst name = let subst = List.fold_left2 (fun subst' s decl -> if is_local_assum decl then s :: subst' else subst') - [] subst (snd k.cl_context) + [] subst k.cl_context in let (_, ty_constr) = instance_constructor (k,u) subst in let termtype = it_mkProd_or_LetIn ty_constr (ctx' @ ctx) in @@ -399,7 +387,7 @@ let do_instance_subst_constructor_and_ty subst k u ctx = let subst = List.fold_left2 (fun subst' s decl -> if is_local_assum decl then s :: subst' else subst') - [] subst (k.cl_props @ snd k.cl_context) + [] subst (k.cl_props @ k.cl_context) in let (app, ty_constr) = instance_constructor (k,u) subst in let termtype = it_mkProd_or_LetIn ty_constr ctx in @@ -530,7 +518,7 @@ let interp_instance_context ~program_mode env ctx ~generalize pl tclass = let u_s = EInstance.kind sigma u in let cl = Typeclasses.typeclass_univ_instance (k, u_s) in let args = List.map of_constr args in - let cl_context = List.map (Termops.map_rel_decl of_constr) (snd cl.cl_context) in + let cl_context = List.map (Termops.map_rel_decl of_constr) cl.cl_context in let _, args = List.fold_right (fun decl (args, args') -> match decl with diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml index 401ba0fba4..12194ea20c 100644 --- a/vernac/comAssumption.ml +++ b/vernac/comAssumption.ml @@ -68,10 +68,12 @@ let declare_axiom is_coe ~poly ~local ~kind typ (univs, pl) imps nl {CAst.v=name let inst = instance_of_univ_entry univs in (gr,inst) -let interp_assumption ~program_mode sigma env impls c = +let interp_assumption ~program_mode env sigma impl_env bl c = let flags = { Pretyping.all_no_fail_flags with program_mode } in - let sigma, (ty, impls) = interp_type_evars_impls ~flags env sigma ~impls c in - sigma, (ty, impls) + let sigma, (impls, ((env_bl, ctx), impls1)) = interp_context_evars ~program_mode ~impl_env env sigma bl in + let sigma, (ty, impls2) = interp_type_evars_impls ~flags env_bl sigma ~impls c in + let ty = EConstr.it_mkProd_or_LetIn ty ctx in + sigma, ty, impls1@impls2 (* When monomorphic the universe constraints and universe names are declared with the first declaration only. *) @@ -153,7 +155,7 @@ let do_assumptions ~program_mode ~poly ~scope ~kind nl l = in (* We interpret all declarations in the same evar_map, i.e. as a telescope. *) let (sigma,_,_),l = List.fold_left_map (fun (sigma,env,ienv) (is_coe,(idl,c)) -> - let sigma,(t,imps) = interp_assumption ~program_mode sigma env ienv c in + let sigma,t,imps = interp_assumption ~program_mode env sigma ienv [] c in let r = Retyping.relevance_of_type env sigma t in let env = EConstr.push_named_context (List.map (fun {CAst.v=id} -> LocalAssum (make_annot id r,t)) idl) env in diff --git a/vernac/comAssumption.mli b/vernac/comAssumption.mli index 3d425ad768..64b8212b90 100644 --- a/vernac/comAssumption.mli +++ b/vernac/comAssumption.mli @@ -14,6 +14,15 @@ open Constrexpr (** {6 Parameters/Assumptions} *) +val interp_assumption + : program_mode:bool + -> Environ.env + -> Evd.evar_map + -> Constrintern.internalization_env + -> Constrexpr.local_binder_expr list + -> constr_expr + -> Evd.evar_map * EConstr.t * Impargs.manual_implicits + val do_assumptions : program_mode:bool -> poly:bool diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml index 37b7106856..c1dbf0a1ea 100644 --- a/vernac/comDefinition.ml +++ b/vernac/comDefinition.ml @@ -81,14 +81,11 @@ let protect_pattern_in_binder bl c ctypopt = else (bl, c, ctypopt, fun f env evd c -> f env evd c) -let interp_definition ~program_mode pl bl ~poly red_option c ctypopt = +let interp_definition ~program_mode env evd impl_env bl red_option c ctypopt = let flags = Pretyping.{ all_no_fail_flags with program_mode } in - let env = Global.env() in - (* Explicitly bound universes and constraints *) - let evd, udecl = Constrexpr_ops.interp_univ_decl_opt env pl in let (bl, c, ctypopt, apply_under_binders) = protect_pattern_in_binder bl c ctypopt in (* Build the parameters *) - let evd, (impls, ((env_bl, ctx), imps1)) = interp_context_evars ~program_mode env evd bl in + let evd, (impls, ((env_bl, ctx), imps1)) = interp_context_evars ~program_mode ~impl_env env evd bl in (* Build the type *) let evd, tyopt = Option.fold_left_map (interp_type_evars_impls ~flags ~impls env_bl) @@ -111,12 +108,15 @@ let interp_definition ~program_mode pl bl ~poly red_option c ctypopt = (* Declare the definition *) let c = EConstr.it_mkLambda_or_LetIn c ctx in let tyopt = Option.map (fun ty -> EConstr.it_mkProd_or_LetIn ty ctx) tyopt in - (c, tyopt), evd, udecl, imps + evd, (c, tyopt), imps let do_definition ?hook ~name ~scope ~poly ~kind udecl bl red_option c ctypopt = let program_mode = false in - let (body, types), evd, udecl, impargs = - interp_definition ~program_mode udecl bl ~poly red_option c ctypopt + let env = Global.env() in + (* Explicitly bound universes and constraints *) + let evd, udecl = Constrexpr_ops.interp_univ_decl_opt env udecl in + let evd, (body, types), impargs = + interp_definition ~program_mode env evd empty_internalization_env bl red_option c ctypopt in let kind = Decls.IsDefinition kind in let cinfo = Declare.CInfo.make ~name ~impargs ~typ:types () in @@ -127,8 +127,11 @@ let do_definition ?hook ~name ~scope ~poly ~kind udecl bl red_option c ctypopt = let do_definition_program ?hook ~pm ~name ~scope ~poly ~kind udecl bl red_option c ctypopt = let program_mode = true in - let (body, types), evd, udecl, impargs = - interp_definition ~program_mode udecl bl ~poly red_option c ctypopt + let env = Global.env() in + (* Explicitly bound universes and constraints *) + let evd, udecl = Constrexpr_ops.interp_univ_decl_opt env udecl in + let evd, (body, types), impargs = + interp_definition ~program_mode env evd empty_internalization_env bl red_option c ctypopt in let term, typ, uctx, obls = Declare.Obls.prepare_obligation ~name ~body ~types evd in let pm, _ = diff --git a/vernac/comDefinition.mli b/vernac/comDefinition.mli index d95e64a85f..7420235449 100644 --- a/vernac/comDefinition.mli +++ b/vernac/comDefinition.mli @@ -14,6 +14,17 @@ open Constrexpr (** {6 Definitions/Let} *) +val interp_definition + : program_mode:bool + -> Environ.env + -> Evd.evar_map + -> Constrintern.internalization_env + -> Constrexpr.local_binder_expr list + -> red_expr option + -> constr_expr + -> constr_expr option + -> Evd.evar_map * (EConstr.t * EConstr.t option) * Impargs.manual_implicits + val do_definition : ?hook:Declare.Hook.t -> name:Id.t diff --git a/vernac/comTactic.ml b/vernac/comTactic.ml new file mode 100644 index 0000000000..8a9a412362 --- /dev/null +++ b/vernac/comTactic.ml @@ -0,0 +1,82 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \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 Goptions + +module Dyn = Dyn.Make() + +module DMap = Dyn.Map(struct type 'a t = 'a -> unit Proofview.tactic end) + +let interp_map = ref DMap.empty + +type 'a tactic_interpreter = 'a Dyn.tag +type interpretable = I : 'a tactic_interpreter * 'a -> interpretable + +let register_tactic_interpreter na f = + let t = Dyn.create na in + interp_map := DMap.add t f !interp_map; + t + +let interp_tac (I (tag,t)) = + let f = DMap.find tag !interp_map in + f t + +type parallel_solver = + pstate:Declare.Proof.t -> + info:int option -> + interpretable -> + abstract:bool -> + with_end_tac:bool -> + Declare.Proof.t + +let print_info_trace = + declare_intopt_option_and_ref ~depr:false ~key:["Info" ; "Level"] + +let solve_core ~pstate n ~info t ~with_end_tac:b = + let pstate, status = Declare.Proof.map_fold_endline ~f:(fun etac p -> + let with_end_tac = if b then Some etac else None in + let info = Option.append info (print_info_trace ()) in + let (p,status) = Proof.solve n info t ?with_end_tac p in + (* in case a strict subtree was completed, + go back to the top of the prooftree *) + let p = Proof.maximal_unfocus Vernacentries.command_focus p in + p,status) pstate in + if not status then Feedback.feedback Feedback.AddedAxiom; + pstate + +let solve ~pstate n ~info t ~with_end_tac = + let t = interp_tac t in + solve_core ~pstate n ~info t ~with_end_tac + +let check_par_applicable pstate = + Declare.Proof.fold pstate ~f:(fun p -> + (Proof.data p).Proof.goals |> List.iter (fun goal -> + let is_ground = + let { Proof.sigma = sigma0 } = Declare.Proof.fold pstate ~f:Proof.data in + let g = Evd.find sigma0 goal in + let concl, hyps = Evd.evar_concl g, Evd.evar_context g in + Evarutil.is_ground_term sigma0 concl && + List.for_all (Context.Named.Declaration.for_all (Evarutil.is_ground_term sigma0)) hyps in + if not is_ground then + CErrors.user_err + Pp.(strbrk("The par: goal selector does not support goals with existential variables")))) + +let par_implementation = ref (fun ~pstate ~info t ~abstract ~with_end_tac -> + let t = interp_tac t in + let t = Proofview.Goal.enter (fun _ -> + if abstract then Abstract.tclABSTRACT None ~opaque:true t else t) + in + solve_core ~pstate Goal_select.SelectAll ~info t ~with_end_tac) + +let set_par_implementation f = par_implementation := f + +let solve_parallel ~pstate ~info t ~abstract ~with_end_tac = + check_par_applicable pstate; + !par_implementation ~pstate ~info t ~abstract ~with_end_tac diff --git a/vernac/comTactic.mli b/vernac/comTactic.mli new file mode 100644 index 0000000000..f1a75e1b6a --- /dev/null +++ b/vernac/comTactic.mli @@ -0,0 +1,47 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \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) *) +(************************************************************************) + +(** Tactic interpreters have to register their interpretation function *) +type 'a tactic_interpreter +type interpretable = I : 'a tactic_interpreter * 'a -> interpretable + +(** ['a] should be marshallable if ever used with [par:] *) +val register_tactic_interpreter : + string -> ('a -> unit Proofview.tactic) -> 'a tactic_interpreter + +(** Entry point for toplevel tactic expression execution. It calls Proof.solve + after having interpreted the tactic, and after the tactic runs it + unfocus as much as needed to put a goal under focus. *) +val solve : + pstate:Declare.Proof.t -> + Goal_select.t -> + info:int option -> + interpretable -> + with_end_tac:bool -> + Declare.Proof.t + +(** [par: tac] runs tac on all goals, possibly in parallel using a worker pool. + If tac is [abstract tac1], then [abstract] is passed + explicitly to the solver and [tac1] passed to worker since it is up to + master to opacify the sub proofs produced by the workers. *) +type parallel_solver = + pstate:Declare.Proof.t -> + info:int option -> + interpretable -> + abstract:bool -> (* the tactic result has to be opacified as per abstract *) + with_end_tac:bool -> + Declare.Proof.t + +(** Entry point when the goal selector is par: *) +val solve_parallel : parallel_solver + +(** By default par: is implemented with all: (sequential). + The STM and LSP document manager provide "more parallel" implementations *) +val set_par_implementation : parallel_solver -> unit diff --git a/vernac/declare.ml b/vernac/declare.ml index ae7878b615..bc38ba3f6d 100644 --- a/vernac/declare.ml +++ b/vernac/declare.ml @@ -1854,7 +1854,8 @@ module MutualEntry : sig val declare_variable : pinfo:Proof_info.t -> uctx:UState.t - -> Entries.parameter_entry + -> sec_vars:Id.Set.t option + -> univs:Entries.universes_entry -> Names.GlobRef.t list val declare_mutdef @@ -1920,10 +1921,11 @@ end = struct in List.map_i (declare_mutdef ~pinfo ~uctx pe) 0 pinfo.Proof_info.cinfo - let declare_variable ~pinfo ~uctx pe = + let declare_variable ~pinfo ~uctx ~sec_vars ~univs = let { Info.scope; hook } = pinfo.Proof_info.info in List.map_i ( fun i { CInfo.name; typ; impargs } -> + let pe = (sec_vars, (typ, univs), None) in declare_assumption ~name ~scope ~hook ~impargs ~uctx pe ) 0 pinfo.Proof_info.cinfo @@ -1953,8 +1955,8 @@ let compute_proof_using_for_admitted proof typ pproofs = Some (Environ.really_needed env (Id.Set.union ids_typ ids_def)) | _ -> None -let finish_admitted ~pm ~pinfo ~uctx pe = - let cst = MutualEntry.declare_variable ~pinfo ~uctx pe in +let finish_admitted ~pm ~pinfo ~uctx ~sec_vars ~univs = + let cst = MutualEntry.declare_variable ~pinfo ~uctx ~sec_vars ~univs in (* If the constant was an obligation we need to update the program map *) match CEphemeron.get pinfo.Proof_info.proof_ending with | Proof_ending.End_obligation oinfo -> @@ -1974,7 +1976,7 @@ let save_admitted ~pm ~proof = let sec_vars = compute_proof_using_for_admitted proof typ pproofs in let uctx = get_initial_euctx proof in let univs = UState.check_univ_decl ~poly uctx udecl in - finish_admitted ~pm ~pinfo:proof.pinfo ~uctx (sec_vars, (typ, univs), None) + finish_admitted ~pm ~pinfo:proof.pinfo ~uctx ~sec_vars ~univs (************************************************************************) (* Saving a lemma-like constant *) @@ -2097,12 +2099,9 @@ let save_lemma_admitted_delayed ~pm ~proof ~pinfo = let poly = match proof_entry_universes with | Entries.Monomorphic_entry _ -> false | Entries.Polymorphic_entry (_, _) -> true in - let typ = match proof_entry_type with - | None -> CErrors.user_err Pp.(str "Admitted requires an explicit statement"); - | Some typ -> typ in - let ctx = UState.univ_entry ~poly uctx in + let univs = UState.univ_entry ~poly uctx in let sec_vars = if get_keep_admitted_vars () then proof_entry_secctx else None in - finish_admitted ~pm ~uctx ~pinfo (sec_vars, (typ, ctx), None) + finish_admitted ~pm ~uctx ~pinfo ~sec_vars ~univs let save_lemma_proved_delayed ~pm ~proof ~pinfo ~idopt = (* vio2vo calls this but with invalid info, we have to workaround @@ -2207,26 +2206,60 @@ let warn_solve_errored = ; fnl () ; str "This will become an error in the future" ]) -let solve_by_tac ?loc name evi t ~poly ~uctx = - (* the status is dropped. *) +let solve_by_tac prg obls i tac = + let obl = obls.(i) in + let obl = subst_deps_obl obls obl in + let tac = Option.(default !default_tactic (append tac obl.obl_tac)) in + let uctx = Internal.get_uctx prg in + let uctx = UState.update_sigma_univs uctx (Global.universes ()) in + let poly = Internal.get_poly prg in + let evi = evar_of_obligation obl in + (* the status of [build_by_tactic] is dropped. *) try let env = Global.env () in let body, types, _univs, _, uctx = - build_by_tactic env ~uctx ~poly ~typ:evi.evar_concl t in + build_by_tactic env ~uctx ~poly ~typ:evi.evar_concl tac in Inductiveops.control_only_guard env (Evd.from_ctx uctx) (EConstr.of_constr body); Some (body, types, uctx) with | Tacticals.FailError (_, s) as exn -> let _ = Exninfo.capture exn in + let loc = fst obl.obl_location in CErrors.user_err ?loc ~hdr:"solve_obligation" (Lazy.force s) (* If the proof is open we absorb the error and leave the obligation open *) | Proof_.OpenProof _ -> None | e when CErrors.noncritical e -> let err = CErrors.print e in + let loc = fst obl.obl_location in warn_solve_errored ?loc err; None +let solve_and_declare_by_tac prg obls i tac = + match solve_by_tac prg obls i tac with + | None -> None + | Some (t, ty, uctx) -> + let obl = obls.(i) in + let poly = Internal.get_poly prg in + let prg = ProgramDecl.Internal.set_uctx ~uctx prg in + let def, obl', _cst = declare_obligation prg obl ~body:t ~types:ty ~uctx in + obls.(i) <- obl'; + if def && not poly then ( + (* Declare the term constraints with the first obligation only *) + let uctx_global = UState.from_env (Global.env ()) in + let uctx = UState.merge_subst uctx_global (UState.subst uctx) in + Some (ProgramDecl.Internal.set_uctx ~uctx prg)) + else Some prg + +let solve_obligation_by_tac prg obls i tac = + let obl = obls.(i) in + match obl.obl_body with + | Some _ -> None + | None -> + if List.is_empty (deps_remaining obls obl.obl_deps) + then solve_and_declare_by_tac prg obls i tac + else None + let get_unique_prog ~pm prg = match State.get_unique_open_prog pm prg with | Ok prg -> prg @@ -2264,49 +2297,6 @@ let rec solve_obligation prg num tac = let lemma = Option.cata (fun tac -> Proof.set_endline_tactic tac lemma) lemma tac in lemma -and obligation (user_num, name, typ) ~pm tac = - let num = pred user_num in - let prg = get_unique_prog ~pm name in - let { obls; remaining } = Internal.get_obligations prg in - if num >= 0 && num < Array.length obls then - let obl = obls.(num) in - match obl.obl_body with - | None -> solve_obligation prg num tac - | Some r -> Error.already_solved num - else Error.unknown_obligation num - -and solve_obligation_by_tac prg obls i tac = - let obl = obls.(i) in - match obl.obl_body with - | Some _ -> None - | None -> - if List.is_empty (deps_remaining obls obl.obl_deps) then - let obl = subst_deps_obl obls obl in - let tac = - match tac with - | Some t -> t - | None -> - match obl.obl_tac with - | Some t -> t - | None -> !default_tactic - in - let uctx = Internal.get_uctx prg in - let uctx = UState.update_sigma_univs uctx (Global.universes ()) in - let poly = Internal.get_poly prg in - match solve_by_tac ?loc:(fst obl.obl_location) obl.obl_name (evar_of_obligation obl) tac ~poly ~uctx with - | None -> None - | Some (t, ty, uctx) -> - let prg = ProgramDecl.Internal.set_uctx ~uctx prg in - let def, obl', _cst = declare_obligation prg obl ~body:t ~types:ty ~uctx in - obls.(i) <- obl'; - if def && not poly then ( - (* Declare the term constraints with the first obligation only *) - let uctx_global = UState.from_env (Global.env ()) in - let uctx = UState.merge_subst uctx_global (UState.subst uctx) in - Some (ProgramDecl.Internal.set_uctx ~uctx prg)) - else Some prg - else None - and solve_prg_obligations ~pm prg ?oblset tac = let { obls; remaining } = Internal.get_obligations prg in let rem = ref remaining in @@ -2333,15 +2323,21 @@ and solve_prg_obligations ~pm prg ?oblset tac = in update_obls ~pm prg obls' !rem -and solve_obligations ~pm n tac = +and auto_solve_obligations ~pm n ?oblset tac : State.t * progress = + Flags.if_verbose Feedback.msg_info + (str "Solving obligations automatically..."); + let prg = get_unique_prog ~pm n in + solve_prg_obligations ~pm prg ?oblset tac + +let solve_obligations ~pm n tac = let prg = get_unique_prog ~pm n in solve_prg_obligations ~pm prg tac -and solve_all_obligations ~pm tac = +let solve_all_obligations ~pm tac = State.fold pm ~init:pm ~f:(fun k v pm -> solve_prg_obligations ~pm v tac |> fst) -and try_solve_obligation ~pm n prg tac = +let try_solve_obligation ~pm n prg tac = let prg = get_unique_prog ~pm prg in let {obls; remaining} = Internal.get_obligations prg in let obls' = Array.copy obls in @@ -2351,14 +2347,19 @@ and try_solve_obligation ~pm n prg tac = pm | None -> pm -and try_solve_obligations ~pm n tac = +let try_solve_obligations ~pm n tac = solve_obligations ~pm n tac |> fst -and auto_solve_obligations ~pm n ?oblset tac : State.t * progress = - Flags.if_verbose Feedback.msg_info - (str "Solving obligations automatically..."); - let prg = get_unique_prog ~pm n in - solve_prg_obligations ~pm prg ?oblset tac +let obligation (user_num, name, typ) ~pm tac = + let num = pred user_num in + let prg = get_unique_prog ~pm name in + let { obls; remaining } = Internal.get_obligations prg in + if num >= 0 && num < Array.length obls then + let obl = obls.(num) in + match obl.obl_body with + | None -> solve_obligation prg num tac + | Some r -> Error.already_solved num + else Error.unknown_obligation num let show_single_obligation i n obls x = let x = subst_deps_obl obls x in diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg index 831aeff6a0..dfc7b05b51 100644 --- a/vernac/g_vernac.mlg +++ b/vernac/g_vernac.mlg @@ -429,19 +429,19 @@ GRAMMAR EXTEND Gram ; record_binder_body: [ [ l = binders; oc = of_type_with_opt_coercion; - t = lconstr -> { fun id -> (oc,AssumExpr (id,mkProdCN ~loc l t)) } + t = lconstr -> { fun id -> (oc,AssumExpr (id,l,t)) } | l = binders; oc = of_type_with_opt_coercion; t = lconstr; ":="; b = lconstr -> { fun id -> - (oc,DefExpr (id,mkLambdaCN ~loc l b,Some (mkProdCN ~loc l t))) } + (oc,DefExpr (id,l,b,Some t)) } | l = binders; ":="; b = lconstr -> { fun id -> match b.CAst.v with | CCast(b', (CastConv t|CastVM t|CastNative t)) -> - (None,DefExpr(id,mkLambdaCN ~loc l b',Some (mkProdCN ~loc l t))) + (NoInstance,DefExpr(id,l,b',Some t)) | _ -> - (None,DefExpr(id,mkLambdaCN ~loc l b,None)) } ] ] + (NoInstance,DefExpr(id,l,b,None)) } ] ] ; record_binder: - [ [ id = name -> { (None,AssumExpr(id, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))) } + [ [ id = name -> { (NoInstance,AssumExpr(id, [], CAst.make ~loc @@ CHole (None, IntroAnonymous, None))) } | id = name; f = record_binder_body -> { f id } ] ] ; assum_list: @@ -452,13 +452,13 @@ GRAMMAR EXTEND Gram ; simple_assum_coe: [ [ idl = LIST1 ident_decl; oc = of_type_with_opt_coercion; c = lconstr -> - { (not (Option.is_empty oc),(idl,c)) } ] ] + { (oc <> NoInstance,(idl,c)) } ] ] ; constructor_type: [[ l = binders; t= [ coe = of_type_with_opt_coercion; c = lconstr -> - { fun l id -> (not (Option.is_empty coe),(id,mkProdCN ~loc l c)) } + { fun l id -> (coe <> NoInstance,(id,mkProdCN ~loc l c)) } | -> { fun l id -> (false,(id,mkProdCN ~loc l (CAst.make ~loc @@ CHole (None, IntroAnonymous, None)))) } ] -> { t l } @@ -469,9 +469,9 @@ GRAMMAR EXTEND Gram [ [ id = identref; c=constructor_type -> { c id } ] ] ; of_type_with_opt_coercion: - [ [ ":>" -> { Some () } - | ":"; ">" -> { Some () } - | ":" -> { None } ] ] + [ [ ":>" -> { BackInstance } + | ":"; ">" -> { BackInstance } + | ":" -> { NoInstance } ] ] ; END diff --git a/vernac/himsg.ml b/vernac/himsg.ml index c16eaac516..5f7eb78a40 100644 --- a/vernac/himsg.ml +++ b/vernac/himsg.ml @@ -831,7 +831,7 @@ let pr_constraints printenv env sigma evars cstrs = (fun (ev, evi) -> fnl () ++ pr_existential_key sigma ev ++ str " : " ++ pr_leconstr_env env' sigma evi.evar_concl ++ fnl ()) l in - h 0 (pe ++ evs ++ pr_evar_constraints sigma cstrs) + h (pe ++ evs ++ pr_evar_constraints sigma cstrs) else let filter evk _ = Evar.Map.mem evk evars in pr_evar_map_filter ~with_univs:false filter env sigma @@ -866,7 +866,7 @@ let explain_unsatisfiable_constraints env sigma constr comp = let info = Evar.Map.find ev undef in explain_typeclass_resolution env sigma info k ++ fnl () ++ cstr -let explain_pretype_error env sigma err = +let rec explain_pretype_error env sigma err = let env = Evardefine.env_nf_betaiotaevar sigma env in let env = make_all_name_different env sigma in match err with @@ -893,7 +893,7 @@ let explain_pretype_error env sigma err = | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type env sigma m n | CannotFindWellTypedAbstraction (p,l,e) -> explain_cannot_find_well_typed_abstraction env sigma p l - (Option.map (fun (env',e) -> explain_type_error env' sigma e) e) + (Option.map (fun (env',e) -> explain_pretype_error env' sigma e) e) | WrongAbstractionType (n,a,t,u) -> explain_wrong_abstraction_type env sigma n a t u | AbstractionOverMeta (m,n) -> explain_abstraction_over_meta env m n @@ -973,8 +973,8 @@ let explain_not_match_error = function (UContext.instance uctx) (UContext.constraints uctx) in - str "incompatible polymorphic binders: got" ++ spc () ++ h 0 (pr_auctx got) ++ spc() ++ - str "but expected" ++ spc() ++ h 0 (pr_auctx expect) ++ + str "incompatible polymorphic binders: got" ++ spc () ++ h (pr_auctx got) ++ spc() ++ + str "but expected" ++ spc() ++ h (pr_auctx expect) ++ (if not (Int.equal (AUContext.size got) (AUContext.size expect)) then mt() else fnl() ++ str "(incompatible constraints)") | IncompatibleVariance -> diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml index 898a262266..8ce59c40c3 100644 --- a/vernac/metasyntax.ml +++ b/vernac/metasyntax.ml @@ -1165,11 +1165,6 @@ let warn_non_reversible_notation = str " not occur in the right-hand side." ++ spc() ++ strbrk "The notation will not be used for printing as it is not reversible.") -type entry_coercion_kind = - | IsEntryCoercion of notation_entry_level - | IsEntryGlobal of string * int - | IsEntryIdent of string * int - let is_coercion level typs = match level, typs with | Some (custom,n,_), [e] -> @@ -1417,8 +1412,7 @@ type notation_obj = { notobj_scope : scope_name option; notobj_interp : interpretation; notobj_coercion : entry_coercion_kind option; - notobj_onlyparse : bool; - notobj_onlyprint : bool; + notobj_use : notation_use option; notobj_deprecation : Deprecation.t option; notobj_notation : notation * notation_location; notobj_specific_pp_rules : syntax_printing_extension option; @@ -1442,37 +1436,19 @@ let open_notation i (_, nobj) = let scope = nobj.notobj_scope in let (ntn, df) = nobj.notobj_notation in let pat = nobj.notobj_interp in - let onlyprint = nobj.notobj_onlyprint in let deprecation = nobj.notobj_deprecation in - let specific = match scope with None -> LastLonelyNotation | Some sc -> NotationInScope sc in - let specific_ntn = (specific,ntn) in - let fresh = not (Notation.exists_notation_in_scope scope ntn onlyprint pat) in - if fresh then begin - (* Declare the interpretation *) - let () = Notation.declare_notation_interpretation ntn scope pat df ~onlyprint deprecation in - (* Declare the uninterpretation *) - if not nobj.notobj_onlyparse then - Notation.declare_uninterpretation (NotationRule specific_ntn) pat; - (* Declare a possible coercion *) - (match nobj.notobj_coercion with - | Some (IsEntryCoercion entry) -> - let (_,level,_) = Notation.level_of_notation ntn in - let level = match fst ntn with - | InConstrEntry -> None - | InCustomEntry _ -> Some level - in - Notation.declare_entry_coercion specific_ntn level entry - | Some (IsEntryGlobal (entry,n)) -> Notation.declare_custom_entry_has_global entry n - | Some (IsEntryIdent (entry,n)) -> Notation.declare_custom_entry_has_ident entry n - | None -> ()) - end; + let scope = match scope with None -> LastLonelyNotation | Some sc -> NotationInScope sc in + (* Declare the notation *) + (match nobj.notobj_use with + | Some use -> Notation.declare_notation (scope,ntn) pat df ~use nobj.notobj_coercion deprecation + | None -> ()); (* Declare specific format if any *) - match nobj.notobj_specific_pp_rules with + (match nobj.notobj_specific_pp_rules with | Some pp_sy -> - if specific_format_to_declare specific_ntn pp_sy then + if specific_format_to_declare (scope,ntn) pp_sy then Ppextend.declare_specific_notation_printing_rules - specific_ntn ~extra:pp_sy.synext_extra pp_sy.synext_unparsing - | None -> () + (scope,ntn) ~extra:pp_sy.synext_extra pp_sy.synext_unparsing + | None -> ()) end let cache_notation o = @@ -1602,6 +1578,20 @@ let make_printing_rules reserved (sd : SynData.syn_data) = let open SynData in synext_extra = sd.extra; } +let warn_unused_interpretation = + CWarnings.create ~name:"unused-notation" ~category:"parsing" + (fun b -> + strbrk "interpretation is used neither for printing nor for parsing, " ++ + (if b then strbrk "the declaration could be replaced by \"Reserved Notation\"." + else strbrk "the declaration could be removed.")) + +let make_use reserved onlyparse onlyprint = + match onlyparse, onlyprint with + | false, false -> Some ParsingAndPrinting + | true, false -> Some OnlyParsing + | false, true -> Some OnlyPrinting + | true, true -> warn_unused_interpretation reserved; None + (**********************************************************************) (* Main functions about notations *) @@ -1614,7 +1604,14 @@ let add_notation_in_scope ~local deprecation df env c mods scope = let sd = compute_syntax_data ~local deprecation df mods in (* Prepare the parsing and printing rules *) let sy_pa_rules = make_parsing_rules sd in - let sy_pp_rules = make_printing_rules false sd in + let sy_pp_rules, gen_sy_pp_rules = + match sd.only_parsing, Ppextend.has_generic_notation_printing_rule (fst sd.info) with + | true, true -> None, None + | onlyparse, has_generic -> + let rules = make_printing_rules false sd in + let _ = check_reserved_format (fst sd.info) rules in + (if onlyparse then None else rules), + (if has_generic then None else (* We use the format of this notation as the default *) rules) in (* Prepare the interpretation *) let i_vars = make_internalization_vars sd.recvars sd.mainvars sd.intern_typs in let nenv = { @@ -1626,22 +1623,18 @@ let add_notation_in_scope ~local deprecation df env c mods scope = let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in let onlyparse,coe = printability (Some sd.level) sd.subentries sd.only_parsing reversibility ac in let notation, location = sd.info in + let use = make_use true onlyparse sd.only_printing in let notation = { notobj_local = local; notobj_scope = scope; notobj_interp = (List.map_filter map i_vars, ac); (* Order is important here! *) - notobj_onlyparse = onlyparse; + notobj_use = use; notobj_coercion = coe; - notobj_onlyprint = sd.only_printing; notobj_deprecation = sd.deprecation; notobj_notation = (notation, location); notobj_specific_pp_rules = sy_pp_rules; } in - let gen_sy_pp_rules = - if Ppextend.has_generic_notation_printing_rule (fst sd.info) then None - else sy_pp_rules (* We use the format of this notation as the default *) in - let _ = check_reserved_format (fst sd.info) sy_pp_rules in (* Ready to change the global state *) List.iter (fun f -> f ()) sd.msgs; Lib.add_anonymous_leaf (inSyntaxExtension (local, (sy_pa_rules,gen_sy_pp_rules))); @@ -1673,14 +1666,14 @@ let add_notation_interpretation_core ~local df env ?(impls=empty_internalization let interp = make_interpretation_vars recvars plevel acvars (List.combine mainvars i_typs) in let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in let onlyparse,coe = printability level i_typs onlyparse reversibility ac in + let use = make_use false onlyparse onlyprint in let notation = { notobj_local = local; notobj_scope = scope; notobj_interp = (List.map_filter map i_vars, ac); (* Order is important here! *) - notobj_onlyparse = onlyparse; + notobj_use = use; notobj_coercion = coe; - notobj_onlyprint = onlyprint; notobj_deprecation = deprecation; notobj_notation = df'; notobj_specific_pp_rules = pp_sy; diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml index 8a98a43ba0..0e660bf20c 100644 --- a/vernac/ppvernac.ml +++ b/vernac/ppvernac.ml @@ -503,18 +503,20 @@ let pr_lconstrarg c = let pr_intarg n = spc () ++ int n let pr_oc = function - | None -> str" :" - | Some () -> str" :>" + | NoInstance -> str" :" + | BackInstance -> str" :>" let pr_record_field (x, { rf_subclass = oc ; rf_priority = pri ; rf_notation = ntn }) = let prx = match x with - | AssumExpr (id,t) -> + | AssumExpr (id,binders,t) -> hov 1 (pr_lname id ++ + pr_binders_arg binders ++ spc() ++ pr_oc oc ++ spc() ++ pr_lconstr_expr t) - | DefExpr(id,b,opt) -> (match opt with + | DefExpr(id,binders,b,opt) -> (match opt with | Some t -> hov 1 (pr_lname id ++ + pr_binders_arg binders ++ spc() ++ pr_oc oc ++ spc() ++ pr_lconstr_expr t ++ str" :=" ++ pr_lconstr b) | None -> @@ -524,8 +526,7 @@ let pr_record_field (x, { rf_subclass = oc ; rf_priority = pri ; rf_notation = n prx ++ prpri ++ prlist (pr_decl_notation @@ pr_constr) ntn let pr_record_decl c fs = - pr_opt pr_lident c ++ (if c = None then str"{" else str" {") ++ - hv 0 (prlist_with_sep pr_semicolon pr_record_field fs ++ str"}") + pr_opt pr_lident c ++ pr_record "{" "}" pr_record_field fs let pr_printable = function | PrintFullContext -> @@ -966,7 +967,7 @@ let pr_vernac_expr v = str":" ++ spc () ++ pr_constr cl ++ pr_hint_info pr_constr_pattern_expr info ++ (match props with - | Some (true, { v = CRecord l}) -> spc () ++ str":=" ++ spc () ++ str"{" ++ pr_record_body l ++ str "}" + | Some (true, { v = CRecord l}) -> spc () ++ str":=" ++ spc () ++ pr_record_body "{" "}" pr_lconstr l | Some (true,_) -> assert false | Some (false,p) -> spc () ++ str":=" ++ spc () ++ pr_constr p | None -> mt())) diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml index 8b00484b4a..06f7c32cdc 100644 --- a/vernac/prettyp.ml +++ b/vernac/prettyp.ml @@ -216,7 +216,7 @@ let print_polymorphism ref = (if poly then str "universe polymorphic" else if template_poly then str "template universe polymorphic " - ++ h 0 (pr_template_variables template_variables) + ++ h (pr_template_variables template_variables) else str "not universe polymorphic") ] let print_type_in_type ref = diff --git a/vernac/record.ml b/vernac/record.ml index 89acd79dda..acc97f61c1 100644 --- a/vernac/record.ml +++ b/vernac/record.ml @@ -62,23 +62,33 @@ let () = let interp_fields_evars env sigma ~ninds ~nparams impls_env nots l = let _, sigma, impls, newfs, _ = List.fold_left2 - (fun (env, sigma, uimpls, params, impls) no ({CAst.loc;v=i}, b, t) -> - let sigma, (t', impl) = interp_type_evars_impls env sigma ~impls t in - let r = Retyping.relevance_of_type env sigma t' in - let sigma, b' = - Option.cata (fun x -> on_snd (fun x -> Some (fst x)) @@ - interp_casted_constr_evars_impls ~program_mode:false env sigma ~impls x t') (sigma,None) b in - let impls = + (fun (env, sigma, uimpls, params, impls_env) no d -> + let sigma, (i, b, t), impl = match d with + | Vernacexpr.AssumExpr({CAst.loc;v=id},bl,t) -> + (* Temporary compatibility with the type-classes heuristics *) + (* which are applied after the interpretation of bl and *) + (* before the one of t otherwise (see #13166) *) + let t = if bl = [] then t else mkCProdN bl t in + let sigma, t, impl = + ComAssumption.interp_assumption ~program_mode:false env sigma impls_env [] t in + sigma, (id, None, t), impl + | Vernacexpr.DefExpr({CAst.loc;v=id},bl,b,t) -> + let sigma, (b, t), impl = + ComDefinition.interp_definition ~program_mode:false env sigma impls_env bl None b t in + let t = match t with Some t -> t | None -> Retyping.get_type_of env sigma b in + sigma, (id, Some b, t), impl in + let r = Retyping.relevance_of_type env sigma t in + let impls_env = match i with - | Anonymous -> impls - | Name id -> Id.Map.add id (compute_internalization_data env sigma id Constrintern.Method t' impl) impls + | Anonymous -> impls_env + | Name id -> Id.Map.add id (compute_internalization_data env sigma id Constrintern.Method t impl) impls_env in - let d = match b' with - | None -> LocalAssum (make_annot i r,t') - | Some b' -> LocalDef (make_annot i r,b',t') + let d = match b with + | None -> LocalAssum (make_annot i r,t) + | Some b -> LocalDef (make_annot i r,b,t) in - List.iter (Metasyntax.set_notation_for_interpretation env impls) no; - (EConstr.push_rel d env, sigma, impl :: uimpls, d::params, impls)) + List.iter (Metasyntax.set_notation_for_interpretation env impls_env) no; + (EConstr.push_rel d env, sigma, impl :: uimpls, d::params, impls_env)) (env, sigma, [], [], impls_env) nots l in let _, _, sigma = Context.Rel.fold_outside ~init:(env,0,sigma) (fun f (env,k,sigma) -> @@ -101,14 +111,6 @@ let compute_constructor_level evars env l = in (EConstr.push_rel d env, univ)) l (env, Univ.Universe.sprop) -let binder_of_decl = function - | Vernacexpr.AssumExpr(n,t) -> (n,None,t) - | Vernacexpr.DefExpr(n,c,t) -> - (n,Some c, match t with Some c -> c - | None -> CAst.make ?loc:n.CAst.loc @@ CHole (None, Namegen.IntroAnonymous, None)) - -let binders_of_decls = List.map binder_of_decl - let check_anonymous_type ind = match ind with | { CAst.v = CSort (Glob_term.UAnonymous {rigid=true}) } -> true @@ -176,7 +178,7 @@ let typecheck_params_and_fields def poly pl ps records = let ninds = List.length arities in let nparams = List.length newps in let fold sigma (_, _, nots, fs) arity = - interp_fields_evars env_ar sigma ~ninds ~nparams impls_env nots (binders_of_decls fs) + interp_fields_evars env_ar sigma ~ninds ~nparams impls_env nots fs in let (sigma, data) = List.fold_left2_map fold sigma records arities in let sigma = @@ -518,7 +520,7 @@ let implicits_of_context ctx = (List.rev (Anonymous :: (List.map RelDecl.get_name ctx))) let declare_class def cumulative ubinders univs id idbuild paramimpls params univ arity - template fieldimpls fields ?(kind=Decls.StructureComponent) coers priorities = + template fieldimpls fields ?(kind=Decls.StructureComponent) coers = let fieldimpls = (* Make the class implicit in the projections, and the params if applicable. *) let impls = implicits_of_context params in @@ -556,10 +558,7 @@ let declare_class def cumulative ubinders univs id idbuild paramimpls params uni Impargs.declare_manual_implicits false cref paramimpls; Impargs.declare_manual_implicits false (GlobRef.ConstRef proj_cst) (List.hd fieldimpls); Classes.set_typeclass_transparency (EvalConstRef cst) false false; - let sub = match List.hd coers with - | Some () -> Some (List.hd priorities) - | None -> None - in + let sub = List.hd coers in let m = { meth_name = Name proj_name; meth_info = sub; @@ -572,10 +571,6 @@ let declare_class def cumulative ubinders univs id idbuild paramimpls params uni let inds = declare_structure ~cumulative Declarations.BiFinite ubinders univs paramimpls params template ~kind:Decls.Method ~name:[|binder_name|] record_data in - let coers = List.map2 (fun coe pri -> - Option.map (fun () -> pri) coe) - coers priorities - in let map ind = let map decl b y = { meth_name = RelDecl.get_name decl; @@ -587,26 +582,17 @@ let declare_class def cumulative ubinders univs id idbuild paramimpls params uni in List.map map inds in - let ctx_context = - let env = Global.env () in - let sigma = Evd.from_env env in - List.map (fun decl -> - match Typeclasses.class_of_constr env sigma (EConstr.of_constr (RelDecl.get_type decl)) with - | Some (_, ((cl,_), _)) -> Some cl.cl_impl - | None -> None) - params, params - in - let univs, ctx_context, fields = + let univs, params, fields = match univs with | Polymorphic_entry (nas, univs) -> let usubst, auctx = Univ.abstract_universes nas univs in let usubst = Univ.make_instance_subst usubst in let map c = Vars.subst_univs_level_constr usubst c in let fields = Context.Rel.map map fields in - let ctx_context = on_snd (fun d -> Context.Rel.map map d) ctx_context in - auctx, ctx_context, fields + let params = Context.Rel.map map params in + auctx, params, fields | Monomorphic_entry _ -> - Univ.AUContext.empty, ctx_context, fields + Univ.AUContext.empty, params, fields in let map (impl, projs) = let k = @@ -614,7 +600,7 @@ let declare_class def cumulative ubinders univs id idbuild paramimpls params uni cl_impl = impl; cl_strict = !typeclasses_strict; cl_unique = !typeclasses_unique; - cl_context = ctx_context; + cl_context = params; cl_props = fields; cl_projs = projs } in @@ -634,7 +620,7 @@ let add_constant_class env sigma cst = let tc = { cl_univs = univs; cl_impl = GlobRef.ConstRef cst; - cl_context = (List.map (const None) ctx, ctx); + cl_context = ctx; cl_props = [LocalAssum (make_annot Anonymous r, t)]; cl_projs = []; cl_strict = !typeclasses_strict; @@ -656,7 +642,7 @@ let add_inductive_class env sigma ind = let r = Inductive.relevance_of_inductive env ind in { cl_univs = univs; cl_impl = GlobRef.IndRef ind; - cl_context = List.map (const None) ctx, ctx; + cl_context = ctx; cl_props = [LocalAssum (make_annot Anonymous r, ty)]; cl_projs = []; cl_strict = !typeclasses_strict; @@ -683,8 +669,8 @@ open Vernacexpr let check_unique_names records = let extract_name acc (rf_decl, _) = match rf_decl with - Vernacexpr.AssumExpr({CAst.v=Name id},_) -> id::acc - | Vernacexpr.DefExpr ({CAst.v=Name id},_,_) -> id::acc + Vernacexpr.AssumExpr({CAst.v=Name id},_,_) -> id::acc + | Vernacexpr.DefExpr ({CAst.v=Name id},_,_,_) -> id::acc | _ -> acc in let allnames = List.fold_left (fun acc (_, id, _, cfs, _, _) -> @@ -739,16 +725,21 @@ let definition_structure udecl kind ~template ~cumulative ~poly finite records = | [r], [d] -> r, d | _, _ -> CErrors.user_err (str "Mutual definitional classes are not handled") in - let priorities = List.map (fun (_, { rf_priority }) -> {hint_priority = rf_priority ; hint_pattern = None}) cfs in - let coers = List.map (fun (_, { rf_subclass }) -> rf_subclass) cfs in + let coers = List.map (fun (_, { rf_subclass=coe; rf_priority=pri }) -> + match coe with + | Vernacexpr.BackInstance -> Some {hint_priority = pri ; hint_pattern = None} + | Vernacexpr.NoInstance -> None) + cfs + in declare_class def cumulative ubinders univs id.CAst.v idbuild - implpars params univ arity template implfs fields coers priorities + implpars params univ arity template implfs fields coers | _ -> let map impls = implpars @ [CAst.make None] @ impls in let data = List.map (fun (univ, arity, implfs, fields) -> (univ, arity, List.map map implfs, fields)) data in let map (univ, arity, implfs, fields) (is_coe, id, _, cfs, idbuild, _) = let coe = List.map (fun (_, { rf_subclass ; rf_canonical }) -> - { pf_subclass = not (Option.is_empty rf_subclass); + { pf_subclass = + (match rf_subclass with Vernacexpr.BackInstance -> true | Vernacexpr.NoInstance -> false); pf_canonical = rf_canonical }) cfs in diff --git a/vernac/vernac.mllib b/vernac/vernac.mllib index 994592a88a..cd0dd5e9a6 100644 --- a/vernac/vernac.mllib +++ b/vernac/vernac.mllib @@ -43,4 +43,5 @@ Topfmt Loadpath ComArguments Vernacentries +ComTactic Vernacinterp diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 60c6d2ec0b..3ced38d6ea 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -700,7 +700,7 @@ let vernac_record ~template udecl ~cumulative k ~poly finite records = if Dumpglob.dump () then let () = Dumpglob.dump_definition id false "rec" in let iter (x, _) = match x with - | Vernacexpr.AssumExpr ({loc;v=Name id}, _) -> + | Vernacexpr.(AssumExpr ({loc;v=Name id}, _, _) | DefExpr ({loc;v=Name id}, _, _, _)) -> Dumpglob.dump_definition (make ?loc id) false "proj" | _ -> () in @@ -776,8 +776,8 @@ let vernac_inductive ~atts kind indl = | _ -> CErrors.user_err Pp.(str "Definitional classes do not support the \"|\" syntax.") in let (coe, (lid, ce)) = l in - let coe' = if coe then Some () else None in - let f = AssumExpr ((make ?loc:lid.loc @@ Name lid.v), ce), + let coe' = if coe then BackInstance else NoInstance in + let f = AssumExpr ((make ?loc:lid.loc @@ Name lid.v), [], ce), { rf_subclass = coe' ; rf_priority = None ; rf_notation = [] ; rf_canonical = true } in vernac_record ~template udecl ~cumulative (Class true) ~poly finite [id, bl, c, None, [f]] else if List.for_all is_record indl then @@ -1790,11 +1790,11 @@ let vernac_print ~pstate = | PrintHintDbName s -> Hints.pr_hint_db_by_name env sigma s | PrintHintDb -> Hints.pr_searchtable env sigma | PrintScopes -> - Notation.pr_scopes (Constrextern.without_symbols (pr_lglob_constr_env env)) + Notation.pr_scopes (Constrextern.without_symbols (pr_glob_constr_env env)) | PrintScope s -> - Notation.pr_scope (Constrextern.without_symbols (pr_lglob_constr_env env)) s + Notation.pr_scope (Constrextern.without_symbols (pr_glob_constr_env env)) s | PrintVisibility s -> - Notation.pr_visibility (Constrextern.without_symbols (pr_lglob_constr_env env)) s + Notation.pr_visibility (Constrextern.without_symbols (pr_glob_constr_env env)) s | PrintAbout (ref_or_by_not,udecl,glnumopt) -> print_about_hyp_globs ~pstate ref_or_by_not udecl glnumopt | PrintImplicit qid -> @@ -1830,7 +1830,7 @@ let vernac_locate ~pstate = let open Constrexpr in function | LocateTerm {v=ByNotation (ntn, sc)} -> let _, env = get_current_or_global_context ~pstate in Notation.locate_notation - (Constrextern.without_symbols (pr_lglob_constr_env env)) ntn sc + (Constrextern.without_symbols (pr_glob_constr_env env)) ntn sc | LocateLibrary qid -> print_located_library qid | LocateModule qid -> Prettyp.print_located_module qid | LocateOther (s, qid) -> Prettyp.print_located_other s qid diff --git a/vernac/vernacexpr.ml b/vernac/vernacexpr.ml index 721e710e1d..6a9a74144f 100644 --- a/vernac/vernacexpr.ml +++ b/vernac/vernacexpr.ml @@ -106,8 +106,7 @@ type search_restriction = type verbose_flag = bool (* true = Verbose; false = Silent *) type coercion_flag = bool (* true = AddCoercion false = NoCoercion *) -type instance_flag = unit option - (* Some () = Backward instance, None = NoInstance *) +type instance_flag = BackInstance | NoInstance type export_flag = bool (* true = Export; false = Import *) @@ -168,8 +167,8 @@ type fixpoint_expr = recursion_order_expr option fix_expr_gen type cofixpoint_expr = unit fix_expr_gen type local_decl_expr = - | AssumExpr of lname * constr_expr - | DefExpr of lname * constr_expr * constr_expr option + | AssumExpr of lname * local_binder_expr list * constr_expr + | DefExpr of lname * local_binder_expr list * constr_expr * constr_expr option type inductive_kind = Inductive_kw | CoInductive | Variant | Record | Structure | Class of bool (* true = definitional, false = inductive *) type simple_binder = lident list * constr_expr diff --git a/vernac/vernacextend.ml b/vernac/vernacextend.ml index eacb7fe6cb..ed63332861 100644 --- a/vernac/vernacextend.ml +++ b/vernac/vernacextend.ml @@ -30,7 +30,6 @@ type vernac_classification = | VtQed of vernac_qed_type (* A proof step *) | VtProofStep of { - parallel : [ `Yes of solving_tac * anon_abstracting_tac | `No ]; proof_block_detection : proof_block_name option } (* Queries are commands assumed to be "pure", that is to say, they @@ -124,7 +123,7 @@ let declare_vernac_classifier name f = let classify_as_query = VtQuery let classify_as_sideeff = VtSideff ([], VtLater) -let classify_as_proofstep = VtProofStep { parallel = `No; proof_block_detection = None} +let classify_as_proofstep = VtProofStep { proof_block_detection = None} type (_, _) ty_sig = | TyNil : (vernac_command, vernac_classification) ty_sig diff --git a/vernac/vernacextend.mli b/vernac/vernacextend.mli index 5ef137cfc0..e1e3b4cfe5 100644 --- a/vernac/vernacextend.mli +++ b/vernac/vernacextend.mli @@ -46,7 +46,6 @@ type vernac_classification = | VtQed of vernac_qed_type (* A proof step *) | VtProofStep of { - parallel : [ `Yes of solving_tac * anon_abstracting_tac | `No ]; proof_block_detection : proof_block_name option } (* Queries are commands assumed to be "pure", that is to say, they |
